diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/.gdbinit | 25 | ||||
| -rw-r--r-- | src/ChangeLog.unicode | 5271 | ||||
| -rw-r--r-- | src/Makefile.in | 235 | ||||
| -rw-r--r-- | src/alloc.c | 95 | ||||
| -rw-r--r-- | src/buffer.c | 46 | ||||
| -rw-r--r-- | src/buffer.h | 30 | ||||
| -rw-r--r-- | src/bytecode.c | 17 | ||||
| -rw-r--r-- | src/callproc.c | 202 | ||||
| -rw-r--r-- | src/casefiddle.c | 162 | ||||
| -rw-r--r-- | src/casetab.c | 88 | ||||
| -rw-r--r-- | src/category.c | 220 | ||||
| -rw-r--r-- | src/category.h | 23 | ||||
| -rw-r--r-- | src/ccl.c | 559 | ||||
| -rw-r--r-- | src/ccl.h | 33 | ||||
| -rw-r--r-- | src/character.c | 1041 | ||||
| -rw-r--r-- | src/character.h | 667 | ||||
| -rw-r--r-- | src/charset.c | 3233 | ||||
| -rw-r--r-- | src/charset.h | 1323 | ||||
| -rw-r--r-- | src/chartab.c | 1048 | ||||
| -rw-r--r-- | src/cmds.c | 21 | ||||
| -rw-r--r-- | src/coding.c | 12595 | ||||
| -rw-r--r-- | src/coding.h | 986 | ||||
| -rw-r--r-- | src/composite.c | 158 | ||||
| -rw-r--r-- | src/composite.h | 62 | ||||
| -rw-r--r-- | src/config.in | 12 | ||||
| -rw-r--r-- | src/data.c | 200 | ||||
| -rw-r--r-- | src/dired.c | 1 | ||||
| -rw-r--r-- | src/dispextern.h | 67 | ||||
| -rw-r--r-- | src/dispnew.c | 2 | ||||
| -rw-r--r-- | src/disptab.h | 10 | ||||
| -rw-r--r-- | src/doc.c | 2 | ||||
| -rw-r--r-- | src/doprnt.c | 2 | ||||
| -rw-r--r-- | src/dosfns.c | 2 | ||||
| -rw-r--r-- | src/editfns.c | 187 | ||||
| -rw-r--r-- | src/emacs.c | 51 | ||||
| -rw-r--r-- | src/fileio.c | 604 | ||||
| -rw-r--r-- | src/filelock.c | 4 | ||||
| -rw-r--r-- | src/fns.c | 863 | ||||
| -rw-r--r-- | src/font.c | 4168 | ||||
| -rw-r--r-- | src/font.h | 582 | ||||
| -rw-r--r-- | src/fontset.c | 2501 | ||||
| -rw-r--r-- | src/fontset.h | 79 | ||||
| -rw-r--r-- | src/frame.c | 130 | ||||
| -rw-r--r-- | src/frame.h | 21 | ||||
| -rw-r--r-- | src/fringe.c | 4 | ||||
| -rw-r--r-- | src/ftfont.c | 1700 | ||||
| -rw-r--r-- | src/ftfont.h | 42 | ||||
| -rw-r--r-- | src/ftxfont.c | 472 | ||||
| -rw-r--r-- | src/indent.c | 6 | ||||
| -rw-r--r-- | src/insdel.c | 59 | ||||
| -rw-r--r-- | src/intervals.c | 2 | ||||
| -rw-r--r-- | src/intervals.h | 2 | ||||
| -rw-r--r-- | src/keyboard.c | 44 | ||||
| -rw-r--r-- | src/keymap.c | 422 | ||||
| -rw-r--r-- | src/lisp.h | 333 | ||||
| -rw-r--r-- | src/lread.c | 793 | ||||
| -rw-r--r-- | src/macfns.c | 8 | ||||
| -rw-r--r-- | src/macgui.h | 2 | ||||
| -rw-r--r-- | src/macterm.c | 121 | ||||
| -rw-r--r-- | src/makefile.w32-in | 127 | ||||
| -rw-r--r-- | src/marker.c | 2 | ||||
| -rw-r--r-- | src/minibuf.c | 29 | ||||
| -rw-r--r-- | src/msdos.c | 10 | ||||
| -rw-r--r-- | src/print.c | 158 | ||||
| -rw-r--r-- | src/process.c | 274 | ||||
| -rw-r--r-- | src/regex.c | 776 | ||||
| -rw-r--r-- | src/regex.h | 11 | ||||
| -rw-r--r-- | src/search.c | 194 | ||||
| -rw-r--r-- | src/syntax.c | 996 | ||||
| -rw-r--r-- | src/syntax.h | 43 | ||||
| -rw-r--r-- | src/term.c | 276 | ||||
| -rw-r--r-- | src/terminal.c | 4 | ||||
| -rw-r--r-- | src/w16select.c | 2 | ||||
| -rw-r--r-- | src/w32bdf.c | 8 | ||||
| -rw-r--r-- | src/w32console.c | 2 | ||||
| -rw-r--r-- | src/w32fns.c | 458 | ||||
| -rw-r--r-- | src/w32font.c | 1531 | ||||
| -rw-r--r-- | src/w32font.h | 58 | ||||
| -rw-r--r-- | src/w32menu.c | 10 | ||||
| -rw-r--r-- | src/w32proc.c | 7 | ||||
| -rw-r--r-- | src/w32select.c | 170 | ||||
| -rw-r--r-- | src/w32term.c | 878 | ||||
| -rw-r--r-- | src/w32term.h | 22 | ||||
| -rw-r--r-- | src/w32xfns.c | 41 | ||||
| -rw-r--r-- | src/window.c | 8 | ||||
| -rw-r--r-- | src/xdisp.c | 1206 | ||||
| -rw-r--r-- | src/xfaces.c | 1074 | ||||
| -rw-r--r-- | src/xfns.c | 393 | ||||
| -rw-r--r-- | src/xfont.c | 827 | ||||
| -rw-r--r-- | src/xftfont.c | 667 | ||||
| -rw-r--r-- | src/xmenu.c | 10 | ||||
| -rw-r--r-- | src/xrdb.c | 23 | ||||
| -rw-r--r-- | src/xselect.c | 31 | ||||
| -rw-r--r-- | src/xterm.c | 793 | ||||
| -rw-r--r-- | src/xterm.h | 11 |
95 files changed, 37859 insertions, 14909 deletions
diff --git a/src/.gdbinit b/src/.gdbinit index ad7b666f188..2c3750bd8de 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -754,7 +754,7 @@ define xchartable print (struct Lisp_Char_Table *) $ptr printf "Purpose: " xprintsym $->purpose - printf " %d extra slots", ($->size & 0x1ff) - 388 + printf " %d extra slots", ($->size & 0x1ff) - 68 echo \n end document xchartable @@ -992,6 +992,29 @@ document xprintsym Print argument as a symbol. end +define xcoding + set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & $valmask) | gdb_data_seg_bits) + set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits) + set $name = $tmp->contents[$arg0 * 2] + print $name + pr + print $tmp->contents[$arg0 * 2 + 1] + pr +end +document xcoding + Print the name and attributes of coding system that has ID (argument). +end + +define xcharset + set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & $valmask) | gdb_data_seg_bits) + set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits) + p $tmp->contents[$arg0->hash_index * 2] + pr +end +document xcharset + Print the name of charset that has ID (argument). +end + define xbacktrace set $bt = backtrace_list while $bt diff --git a/src/ChangeLog.unicode b/src/ChangeLog.unicode new file mode 100644 index 00000000000..2577db74d4f --- /dev/null +++ b/src/ChangeLog.unicode @@ -0,0 +1,5271 @@ +2007-12-27 Kenichi Handa <handa@ni.aist.go.jp> + + * ftfont.c (ftfont_drive_otf): Fix setting of FROM and TO slots of + glyphs. + + * font.h (struct font_driver): Docstring of member `shape' is + improved. + +2007-12-25 Kenichi Handa <handa@m17n.org> + + * composite.c (syms_of_composite): Fix docstring of + auto-composition-function. + + * font.h (LGLYPH_SIZE): New macro. + + * font.c (Ffont_fill_gstring): Stop filling when a character not + supported by the font is found. + (Ffont_shape_text): When a shape callback function returns nil, + try at most two more times with larger gstring. + (Ffont_at): Fix getting of w. Call font_at with correct 5th + argument. + + * xdisp.c (handle_auto_composed_prop): Change the argument to + auto-composition-function. + + * ftfont.c (ftfont_encode_char): Use the macro FONT_INVALID_CODE. + (ftfont_shape_by_flt): If an element of lgstring is nil, make a + Lispy glyph and store it in the lgstring. + + * xfont.c (xfont_encode_char): Use the macro FONT_INVALID_CODE. + + * xftfont.c (xftfont_encode_char): Use the macro FONT_INVALID_CODE. + +2007-12-21 Kenichi Handa <handa@ni.aist.go.jp> + + * font.c (Ffont_shape_text): Avoid unnecessary composition. + + * fontset.c (Vfont_encoding_charset_alist): New variable. + (syms_of_fontset): DEFVAR it. + (reorder_font_vector): Optimize for the case of no need of + reordring. + (fontset_find_font): Likewise. + (face_for_char): Map the charset property by + Vfont_encoding_charset_alist. + +2007-12-20 Jason Rumney <jasonr@gnu.org> + + * w32font.c (logfonts_match): Don't check adstyle here. + (font_matches_spec): Check here against physical font instead. + (add_font_entity_to_list): Avoid some substitutions. + + * font.c (font_parse_fcname): Default weight and slant to normal. + (font_score): Prefer normal fonts if weight or slant unspecified. + (font_score) [WINDOWSNT]: Scale weight difference down to closer + match freetype scores. + +2007-12-19 Jason Rumney <jasonr@gnu.org> + + * w32font.c (w32font_text_extents): Don't use the frame stored in the + font, as it may have been deleted. + (w32_enumfont_pattern_entity): Map generic family to adstyle using + most common hyphenless variation. + (logfonts_match): Check generic family. + (font_matches_spec): Don't check generic family here. + (fill_in_logfont): Set generic family based on adstyle. + + * w32font.h (w32font_get_cache): Update declaration. + +2007-12-18 Kenichi Handa <handa@ni.aist.go.jp> + + * ftfont.c (ftfont_get_cache): Adjust the argument type. + + * frame.c (x_set_font_backend): Don't call Fclear_font_cache. If + none of the new drivers are available, call font_update_drviers + with the old drivers. + + * w32font.c (w32font_get_cache): Adjust the argument type. + + * xfont.c (xfont_get_cache): Adjust the argument type. + + * font.h (struct font_driver): Change argument type of get_cache. + + * xftfont.c (xftfont_start_for_frame): Delete prototype. + + * font.c (Ffont_get): Fix arguments to Fassoc. + (font_prepare_cache, font_finish_cache, font_get_cache): New + functions. + (font_clear_cache): New function. + (font_list_entities): Use font_get_cache. + (font_matching_entity): Likewise. + (font_update_drivers): Call font_clear_cache when finishing a + driver. + + * fontset.c (fontset_find_font): Fix previous change. + +2007-12-14 Kenichi Handa <handa@ni.aist.go.jp> + + * xterm.c (x_check_font) [USE_FONT_BACKEND]: Don't access + dpyinfo->font_table. + (x_delete_display) [USE_FONT_BACKEND]: Likewise. + (x_delete_terminal) [USE_FONT_BACKEND]: Likewise + + * font.c (font_at): Handle the case that the arg C is negative. + Handle the unibyte case. + (Ffont_at): Call font_at with the arg C -1. + + * xdisp.c (handle_auto_composed_prop): Don't get a character at + the position here, and call font_at with the arg C -1. Don't + check the range of the existing composition at the point. + +2007-12-13 Kenichi Handa <handa@ni.aist.go.jp> + + * fontset.c (fontset_add): New args charset_id and famliy. Caller + changed. + (load_font_get_repertory): Assume that font_spec is always a + font-spec object. + (fontset_find_font): Likewise. + (Fset_fontset_font): Always store a font-spec object in a fontset. + + * xdisp.c (handle_auto_composed_prop): Use Fget_text_property + instead of get_property_and_range. + +2007-12-10 Kenichi Handa <handa@ni.aist.go.jp> + + * xftfont.c (struct xftfont_info): Delete the member ft_face. + (xftfont_open): Don't keep locking face. + (xftfont_close): Don't unlock face. + (xftfont_anchor_point): Lock and unlock face. + (xftfont_shape): Likewise. + + * fontset.c (fontset_find_font): Don't prefer a font of + supplementary charset. + +2007-12-09 Kenichi Handa <handa@m17n.org> + + * ftfont.c (struct OpenTypeSpec): Members script_tag renamed to + script, langsys_tag renamed to langsys, new member script. + (OTF_TAG_STR): Terminate by '\0'. + (ftfont_get_open_type_spec): If :otf prop is is spec, Limit the + listing to the script specified in that property. Fix arg to + OTF_check_features. + +2007-12-08 Jason Rumney <jasonr@gnu.org> + + * w32font.h: New file. + + * w32font.c: Include it. + (struct w32font_info): Add owning_frame field. Move to w32font.h. + (w32font_open): Set owning_frame. + (w32font_text_extents): Use owning_frame. + (struct font_callback_data): Add opentype_only field. + (add_font_entity_to_list): Use it to filter fonts. + Don't check against full name. + (w32font_list_internal): New function. + (w32font_list): Use it. + (w32font_match_internal): New function. + (w32font_match): Use it. + (w32font_open_internal): New function. + (w32font_open): Use it. + (w32font_get_cache, w32font_close, w32font_has_char) + (w32font_encode_char, w32font_text_extents, w32font_draw): + Make non-static. + + * makefile.w32-in (w32font.o): Depend on w32font.h. + +2007-12-06 Kenichi Handa <handa@ni.aist.go.jp> + + * charset.c (Fdefine_charset_internal): Record a supplementary + charset at the tail of Vcharset_order_list. + + * font.c (Ffont_shape_text): Fix the return value. + + * ftfont.c (OTF_SYM_TAG, OTF_TAG_STR): Fix argument names. + + * xdisp.c (handle_auto_composed_prop): Fix previous change. + +2007-12-05 Kenichi Handa <handa@ni.aist.go.jp> + + * ftfont.c (struct OpenTypeSpec): New struct. + (OTF_SYM_TAG, OTF_TAG_STR): New macros. + (ftfont_get_open_type_spec): New function. + (ftfont_list) [HAVE_LIBOTF]: Check otf-spec property. + + * lread.c (read1): Redo the previous change with checking + Vpurify_flag. + +2007-12-04 Jason Rumney <jasonr@gnu.org> + + * w32font.c (add_font_entity_to_list): Compare only the beginning + of full name. + +2007-12-04 Kenichi Handa <handa@m17n.org> + + * xdisp.c (handle_auto_composed_prop): Simplify the code. Never + return HANDLED_RECOMPUTE_PROPS. + +2007-12-03 Kenichi Handa <handa@m17n.org> + + * font.c (font_gstring_produce): Delete it. + + * composite.h (COMPOSITION_METHOD): Handle + COMPOSITION_WITH_GLYPH_STRING. + +2007-12-04 Kenichi Handa <handa@ni.aist.go.jp> + + * xfont.c (Qx): Deleted. + (syms_of_xfont): Don't initialize Qx. + + * composite.h (enum composition_method): Define + COMPOSITION_WITH_GLYPH_STRING unconditionally. + +2007-12-03 Kenichi Handa <handa@ni.aist.go.jp> + + * xfaces.c [HAVE_WINDOW_SYSTEM]: Include "font.h" unconditionally. + (choose_face_font): Accept new form of font-spec. + + * frame.h (font_driver_list): Declare it unconditionally. + (struct frame): Define members font_driver_list and font_data_list + unconditionally. + + * fontset.c: Include "font.h" unconditionally. + (generate_ascii_font_name): Use font_parse_xlfd and + font_unparse_xlfd. + (Fset_fontset_font): Accept a font-spec object. + + * font.c (font_unparse_xlfd): If pixel_size is zero, make the + PIXEL_SIZE part a wild card. + + * dispextern.h (struct glyph_string): Define members clip and + num_clips unconditionally. + (struct face): Define members font_info and extra unconditionally. + + * ftfont.c (ftfont_open): Set members maybe_otf and otf of + ftfont_info only when HAVE_LIBOTF is defined. + +>>>>>>> 1.1.2.202 +2007-12-02 Andreas Schwab <schwab@suse.de> + + * xdisp.c (back_to_previous_visible_line_start): Fix type of beg + and end. + +2007-12-01 Jason Rumney <jasonr@gnu.org> + + * w32font.c (w32font_driver): Add new fields. + +2007-12-01 Kenichi Handa <handa@ni.aist.go.jp> + + * config.in: Re-generated. + + * Makefile.in (ALL_CFLAGS): Add @M17N_FLT_CFLAGS@. + (FONTSRC, FONTOBJ) [HAVE_WINDOW_SYSTEM]: Set them unconditionally. + (LIBES): Add @M17N_FLT_CFLAGS@. + + * composite.c (compose_text): Don't treat the new style + composition specially. + + * emacs.c (main): Call syms_of_font unconditionally. + + * font.h (FONT_ENTITY_NOT_LOADABLE) + (FONT_ENTITY_SET_NOT_LOADABLE): New macros. + (LGSTRING_XXXX, LGLYPH_XXX): Adjusted for the change of lispy + gstring. + (struct font_driver): New member shape. + (font_registry_charsets): Extern. it. + (font_find_for_lface): Prototype adjusted. + (font_prepare_composition): Likewise. + (font_otf_capability, font_drive_otf): Delete their externs. + + * font.c [HAVE_M17N_FLT]: Include <m17n-flt.h>. + (font_charset_alist): Moved from xfont.c and renamed. + (font_registry_charsets): Likewise. + (font_prop_validate_otf): New function. + (font_property_table): Register it for QCotf. + (DEVICE_DELTA, adjust_anchor, REPLACEMENT_CHARACTER) + (font_drive_otf): Deleted. + (font_prepare_composition): New arg F. Adjusted for the change of + lispy gstring. + (font_find_for_lface): New arg C. + (font_load_for_face): Adjusted for the change of + font_find_for_lface. + (Ffont_make_gstring): Adjusted for the change of lispy gstring. + (Ffont_fill_gstring): Likewise. + (Ffont_shape_text): New function. + (Fopen_font): If the font size is not given, use 12-pixel. + (Ffont_at): New arg STRING. + (syms_of_font): Initalize font_charset_alist. Declare + Ffont_shape_text as a Lisp function. Call syms_of_XXfont + conditionally. + + * fontset.c (fontset_find_font) [USE_FONT_BACKEND]: Try multiple + fonts of the same font-spec. Change the format of RFONT-DEF. + (face_for_char): Adjusted for the change of RFONT-DEF. + (make_fontset_for_ascii_face): Likewise. + (Finternal_char_font): Likewise. + (Fset_fontset_font) [USE_FONT_BACKEND]: Handle new format of + font-spec. + + * ftfont.h: New file. + + * ftfont.c: Don't include Freetype headers. Include "ftfont.h". + (struct ftfont_info) [HAVE_LIBOTF]: New members maybe_otf and otf. + (ftfont_open) [HAVE_LIBOTF]: Initialize the above members. + (ftfont_driver) [HAVE_LIBOTF, HAVE_M17N_FLT]: Don't set + font_otf_capability and font_drive_otf, set ftfont_shape. + (ftfont_list): Adjusted for the change of :otf property value. + (struct MFLTFontFT) [HAVE_LIBOTF, HAVE_M17N_FLT]: New struct. + (ftfont_get_glyph_id, ftfont_get_metrics, ftfont_check_otf) + (adjust_anchor, ftfont_drive_otf, ftfont_shape_by_flt) + (ftfont_shape) [HAVE_LIBOTF, HAVE_M17N_FLT]: New function.s + (DEVICE_DELTA) [HAVE_LIBOTF, HAVE_M17N_FLT]: New macro. + (otf_gstring, gstring, m17n_flt_initialized): New variables. + + * w32term.c (x_draw_composite_glyph_string_foreground): Adjusted + for the change of lispy gstring. + + * xdisp.c (handle_composition_prop): Adjusted for the change of + lispy gstring. Call a function for auto-composition with the +third arg it->window. + (fill_composite_glyph_string): Adjusted for the change of lispy + string. + (x_produce_glyphs): Adjusted for the change of + font_prepare_compositionl. + + * xfaces.c (set_font_frame_param): Adjusted for the change of + font_find_for_lface. + + * xfont.c (x_font_charset_alist): Moved to font.c and renamed. + (xfont_registry_charsets): Likewise. Caller changed. + (syms_of_xfont): Don't handle x_font_charset_alist. + + * xftfont.c: Include "ftfont.h". + (struct xftfont_info) [HAVE_LIBOTF]: New members maybe_otf and + otf. + (xftfont_open) [HAVE_LIBOTF]: Initialize the above members. + (xftfont_close) [HAVE_LIBOTF]: Close otf. + (xftfont_shape) [HAVE_LIBOTF, HAVE_M17N_FLT]: New function. + (syms_of_xftfont) [HAVE_LIBOTF, HAVE_M17N_FLT]: Set + xftfont_driver.shape to xftfont_shape. + + * xterm.c (x_draw_composite_glyph_string_foreground): Adjusted for + the change of lispy gstring. + +2007-11-29 Kenichi Handa <handa@ni.aist.go.jp> + + * ftxfont.c (ftxfont_end_for_frame): Fix array indexing error. + +2007-12-01 Jason Rumney <jasonr@gnu.org> + + * w32font.c (w32font_draw): Fill background manually. + +2007-11-23 Jason Rumney <jasonr@gnu.org> + + * font.c (Qfontp): Remove unused symbol. + (QCantialias): New symbol. + (syms_of_font): Define it. + (font_property_table): Set a validator for QCantialias. + + * w32font.c (CLEARTYPE_QUALITY, CLEARTYPE_NATURAL_QUALITY): Define + if not already. + (QCfamily): Share with xfaces.c. + (Qstandard, Qsubpixel, Qnatural): New symbols. + (syms_of_w32font): Define them. Don't define QCfamily here. + (w32_antialias_type, lispy_antialias_type): New functions. + (w32_enumfont_pattern_entity): New arg requested_font. + Set antialias parameter if non-default was requested. + (fill_in_logfont): Fill in lfQuality if :antialias specified. + +2007-11-21 Kenichi Handa <handa@ni.aist.go.jp> + + * lread.c (read1): Undo the previous change. + +2007-11-21 CHENG Gao <chenggao@gmail.com> (tiny change) + + * frame.c (Fdelete_frame): Call font_update_drivers only when + USE_FONT_BACKEND is defined.. + +2007-11-19 Kenichi Handa <handa@ni.aist.go.jp> + + * font.h (struct font_bitmap): New member bits_per_pixel. + (struct font_driver): New members start_for_frame and end_for_frame. + (struct font_data_list): New struct. + (font_put_frame_data, font_get_frame_data): Extern them. + + * frame.h (struct frame): New member font_data_list. + + * font.c (font_update_drivers): Call driver->start_for_frame and + driver->end_for_frame at proper timings. + (font_put_frame_data, font_get_frame_data): New functions. + (Ffont_spec): Add usage in the docstring. + + * frame.c (make_frame): Initialize f->font_data_list to NULL. + (Fdelete_frame): Call font_update_drivers. + + * xftfont.c (struct xftface_info): Delete the member xft_draw. + (xftfont_prepare_face): Adjusted for the above change. + (xftfont_done_face): Likewise. + (xftfont_get_xft_draw): New function. + (xftfont_draw): Get XftDraw by xftfont_get_xft_draw. + (xftfont_end_for_frame): New function. + (syms_of_xftfont): Set xftfont_driver.end_for_frame. + + * ftxfont.c (ftxfont_get_gcs): Renamed from ftxfont_create_gcs. + Argument changed. Cache GCs in the per-frame data. + (struct ftxfont_frame_data): New struct. + (ftxfont_draw_bitmap): New arg gc_fore and flush. + (ftxfont_prepare_face, ftxfont_done_face): Delete them. + (ftxfont_draw): Get GCs by ftxfont_get_gcs. Reflect s->clip in + GCs. + (ftxfont_end_for_frame): New function. + (syms_of_ftxfont): Set ftxfont_driver.end_for_frame. + + * ftfont.c (ftfont_get_bitmap): Set bitmap->bits_per_pixel. + +2007-11-18 Kenichi Handa <handa@m17n.org> + + * xselect.c (Vselection_coding_system) + (Vnext_selection_coding_system): Delete them. + (syms_of_xselect): Don't declare selection-coding-system and + next-selection-coding-system. They are declared in select.el. + +2007-11-17 Jason Rumney <jasonr@gnu.org> + + * w32term.h (WM_UNICHAR, UNICODE_NOCHAR): Define if not already. + + * w32fns.c: Include imm.h. + (get_composition_string_fn, get_ime_context_fn): New optional + system functions. + (globals_of_w32fns): Load them from imm32.dll. + (ignore_ime_char): New flag. + (w32_wnd_proc): Handle WM_UNICHAR, WM_IME_CHAR and + WM_IME_ENDCOMPOSITION messages. + + * w32term.c (w32_read_socket) [WM_UNICHAR]: Handle as + MULTIBYTE_CHAR_KEYSTROKE_EVENT. + +2007-11-14 Kenichi Handa <handa@ni.aist.go.jp> + + * lread.c (READCHAR): Call readchar with the 2nd arg NULL. + (READCHAR_REPORT_MULTIBYTE): New macro. + (readchar): New 2nd arg MULTIBYTE. + (read1): Use READCHAR_REPORT_MULTIBYTE for the first read. Make + symbol's name multibyte according to the multibyteness of the + source. + +2007-11-12 Kenichi Handa <handa@ni.aist.go.jp> + + * xfaces.c (face_for_overlay_string): Call lookup_face with + correct arguments (fix of synching with the trunk). + +2007-11-05 Kenichi Handa <handa@m17n.org> + + * font.c (font_prop_validate_symbol): The argument prop_index is + deleted. + (font_prop_validate_style, font_prop_validate_non_neg) + (font_prop_validate_spacing): Likewise. + (font_property_table): Arguments to validater changed. Callers + changed. + (font_lispy_object): Deleted. + (font_at): Use font_find_object instead fo font_lispy_object. + +2007-11-02 Kenichi Handa <handa@ni.aist.go.jp> + + * fileio.c (Fexpand_file_name): Adjust multibyteness of directory + and file names. + +2007-10-27 Jason Rumney <jasonr@gnu.org> + + * w32font.c (add_font_name_to_list): Avoid vertical fonts. + (font_matches_spec): Remove debug output. + (add_font_entity_to_list): Avoid using substituted fonts. + +2007-10-21 Jason Rumney <jasonr@gnu.org> + + * doc.c (Fsnarf_documentation): + * Makefile.in (temacs${EXEEXT}, mostlyclean): Undo last change. + +2007-10-12 Miles Bader <miles@gnu.org> + + * src/dispextern.h (struct glyph_row): Only define "clip" field if + HAVE_WINDOW_SYSTEM is defined. + +2007-10-12 Stefan Monnier <monnier@iro.umontreal.ca> + + Fix up multi-tty merge. + + * xterm.c (handle_one_xevent): Remove duplicate code and fix up nesting + and indentation. + + * xfaces.c (free_realized_face, clear_face_gcs): + Include font_done_for_face in the input_blocked section, just in case. + + * xdisp.c (decode_mode_spec): Use terminal-local coding systems. + (get_char_face_and_encoding): Undo last change and remove the *other* + duplicate definition (i.e. keep the one that's better scoped and that + includes code for the font-backend). + + * terminal.c (create_terminal): Default keyboard_coding to + `no-conversion' and terminal_coding to `undecided'. + + * lread.c (read1): Use XSETPVECTYPE to set a pseudovector's tag. + + * fontset.c (free_realized_fontsets): Check that the table entry does + contain a fontset before trying to compare it to `base'. + + * emacs.c (main): Move syms_of_data, syms_of_fileio, syms_of_alloc, + syms_of_charset, and syms_of_coding earlier because init_window_once + now needs Vcoding_system_hash_table to be setup. + + * coding.h (default_buffer_file_coding): Remove. + + * coding.c (default_buffer_file_coding): Remove. + (Fterminal_coding_system, Fkeyboard_coding_system): Use ->id rather + than ->symbol, and use the terminal-local coding system. + (syms_of_coding): Don't setup the coding-systems that are not + terminal-local. + (Fdefine_coding_system_internal): Use XCAR/XCDR. + + * chartab.c (Fmake_char_table, make_sub_char_table, copy_char_table): + Use XSETPVECTYPE now that XSETCHAR_TABLE doesn't set the tag anymore. + + * alloc.c (Fmake_char_table, make_sub_char_table): Remove. They're now + in chartab.c and were re-added here by mistake. + (Fpurecopy): Use XSETPVECTYPE after copying a COMPILED pseudovector. + + * doc.c (Fsnarf_documentation): + * Makefile.in (temacs${EXEEXT}, mostlyclean): Move buildobj.lst from + src to etc. + + * ChangeLog.10: Add mistakenly removed entry. + +2007-10-12 Dan Nicolaescu <dann@ics.uci.edu> + + * Makefile.in (fringe.o, minibuf.o): Fix dependencies. + +2007-10-11 Miles Bader <miles@gnu.org> + + * xdisp.c (get_char_face_and_encoding): Remove extraneous definition. + Add extra args to FACE_FOR_CHAR. + +2007-09-20 Kenichi Handa <handa@m17n.org> + + * keymap.c (where_is_internal_1): If key is a cons, store the copy + in sequence. + + * chartab.c (map_sub_char_table): If the range contains just one + character, call the function with that character even if the depth + is not 3. + (map_char_table): Likewise. + +2007-09-19 Jason Rumney <jasonr@gnu.org> + + * w32font.c (w32font_text_extents): Calculate metrics for the + whole string. + +2007-09-15 Jason Rumney <jasonr@gnu.org> + + * w32xfns.c (get_next_msg): Consolidate WM_PAINT messages. + +2007-09-13 Jason Rumney <jasonr@gnu.org> + + * w32term.c (x_set_glyph_string_clipping): Use + get_glyph_string_clip_rects. + (x_set_glyph_string_clipping_exactly): Adjusted for the change of + struct glyph_string. + (x_draw_glyph_string): Likewise. + + * w32font.c (w32font_draw): Do clipping here. + +2007-09-13 Kenichi Handa <handa@m17n.org> + + * xftfont.c (xftfont_draw): Adjusted for the change of struct + glyph_string. + + * xterm.c (x_set_glyph_string_clipping): Use + get_glyph_string_clip_rects. + (x_set_glyph_string_clipping_exactly): Adjusted for the change of + struct glyph_string. + (x_draw_glyph_string): Likewise. + + * xdisp.c (get_glyph_string_clip_rects): Reflect s->row->clip to + the resulting clip(s}. + (expose_overlaps): Add arg r. Callers changed. Set it ot + row->clip temporarily. + (expose_window): Redraw rows overlapping the exposed area. + + * dispextern.h (struct glyph_row): New member clip. + (struct glyph_string): Delete members clip_x, clip_y, clip_width, + clip_height, new member clip, and num_clips. + +2007-09-07 Kenichi Handa <handa@m17n.org> + + * data.c (Fchar_or_string_p): Fix docstring. + +2007-08-22 Kenichi Handa <handa@m17n.org> + + * xftfont.c (xftfont_draw): If s->font_info != s->face->font_info, + create a temporal XftDraw object. + +2007-07-26 Kenichi Handa <handa@m17n.org> + + * font.c (Ffontp): Fix docstring. + + * coding.c (detect_coding_iso_2022): Don't treat SI/SO codes as a + strong evidence of ISO-2022. + +2007-07-23 Kenichi Handa <handa@m17n.org> + + * abbrev.c (abbrev_check_chars): Use CHAR_TABLE_REF, not + SYNTAX_ENTRY_FOLLOW_PARENT. + +2007-06-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * fns.c (weak_hash_tables): Rename from Vweak_hash_tables and change + its type. + (make_hash_table, copy_hash_table, sweep_weak_hash_tables, init_fns): + Update to the new type of weak_hash_tables and next_weak. + + * lisp.h (struct Lisp_Hash_Table): Change next_weak from Lisp_Object to + a plain C pointer to Lisp_Hash_Table. + + * lisp.h (XGCTYPE, GC_HASH_TABLE_P, GC_NILP, GC_NUMBERP, GC_NATNUMP) + (GC_INTEGERP, GC_SYMBOLP, GC_MISCP, GC_VECTORLIKEP, GC_STRINGP) + (GC_CONSP, GC_FLOATP, GC_VECTORP, GC_OVERLAYP, GC_MARKERP) + (GC_INTFWDP, GC_BOOLFWDP, GC_OBJFWDP, GC_BUFFER_OBJFWDP) + (GC_BUFFER_LOCAL_VALUEP, GC_SOME_BUFFER_LOCAL_VALUEP) + (GC_KBOARD_OBJFWDP, GC_PSEUDOVECTORP, GC_WINDOW_CONFIGURATIONP) + (GC_PROCESSP, GC_WINDOWP, GC_SUBRP, GC_COMPILEDP, GC_BUFFERP) + (GC_SUB_CHAR_TABLE_P, GC_CHAR_TABLE_P, GC_BOOL_VECTOR_P, GC_FRAMEP) + (GC_EQ): Remove since they've been identical to their non-GC_ + alter-egos ever since the markbit was eradicated. + + * src/alloc.c: + * src/buffer.c: + * src/buffer.h: + * src/data.c: + * src/fileio.c: + * src/filelock.c: + * src/fns.c: + * src/frame.h: + * src/lisp.h: + * src/macterm.c: + * src/print.c: + * src/process.c: + * src/w32fns.c: + * src/w32menu.c: + * src/w32term.c: + * src/xfns.c: + * src/xmenu.c: + * src/xterm.c: Replace uses of GC_* macros with the non-GC_ versions. + +2007-06-25 Kenichi Handa <handa@m17n.org> + + * chartab.c (map_sub_char_table): Make it work for the top-level + char-table. Fix handling of parent char-table. + (map_char_table): Adjust for the above change. + +2007-06-24 Jason Rumney <jasonr@gnu.org> + + * w32font.c (Qgdi): Rename from Qw32. + +2007-06-22 Jason Rumney <jasonr@gnu.org> + + * w32bdf.c (get_quoted_string): Make function static. + +2007-06-20 Kenichi Handa <handa@m17n.org> + + * xftfont.c (xftfont_open): If one of font's ASCII glyph has + bigger ascent and descent than those of the font, use them as + font's ascent and descent. + +2007-06-18 Kenichi Handa <handa@m17n.org> + + * Makefile.in (${lispsource}international/charprop.el): Move this + target within "#ifdef HAVE_UNIDATA" and "#endif". + +2007-06-16 Kenichi Handa <handa@m17n.org> + + * Makefile.in (lisp): Add ${lispsource}language/tai-viet.el. + (shortlisp): Add ../lisp/language/tai-viet.el. + +2007-06-15 Ulrich Mueller <ulm@gentoo.org> (tiny change) + + * Makefile.in (${lispsource}international/charprop.el): Depend on + temacs${EXEEXT}. + +2007-06-13 Jason Rumney <jasonr@gnu.org> + + * w32font.c (w32font_close): Delete the GDI font object. + + * w32menu.c: Include character.h + + * w32proc.c: Likewise. + + * w32select.c: Likewise. + + * makefile.w32-in (w32proc.o): Depend on character.h + +2007-06-11 Jason Rumney <jasonr@gnu.org> + + * w32fns.c (syms_of_w32fns): Use DEFSYM macro. + + * w32menu.c (syms_of_w32menu): Likewise. + + * w32proc.c (syms_of_ntproc): Likewise. + + * w32select.c (syms_of_w32select): Likewise. + + * w32term.c (syms_of_w32term): Likewise. + +2007-06-06 Jason Rumney <jasonr@gnu.org> + + * w32font.c (w32font_draw): Delete brush after using it. + +2007-06-04 Jason Rumney <jasonr@gnu.org> + + * w32font.c (w32font_open): Don't set font_idx. + (w32font_text_extents): Try GetTextExtentPoint32W before defaulting + to font settings. + (w32font_draw): Fill background explicitly. + +2007-06-03 Jason Rumney <jasonr@gnu.org> + + * w32term.c (w32_initialize): Don't call w32font_initialize. + + * w32font.c (w32font_info): Remove subranges. + (QCsubranges, Qmodern, Qswiss, Qroman): Remove. + (QCfamily, Qmonospace, Qsans_serif, Qmono, Qsans, Qsans__serif) + (Qraster, Qoutline, Qlatin, Qgreek, Qcoptic, Qcyrillic, Qarmenian) + (Qhebrew, Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali) + (Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu, Qkannada) + (Qmalayalam, Qsinhala, Qthai, Qlao, Qtibetan, Qmyanmar, Qgeorgian) + (Qhangul, Qethiopic, Qcherokee, Qcanadian_aboriginal, Qogham) + (Qrunic, Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan) + (Qideographic_description, Qcjk_misc, Qkana, Qbopomofo, Qkanbun) + (Qyi, Qbyzantine_musical_symbol, Qmusical_symbol, Qmathematical): + New symbols. + (font_callback_data): New struct. + (w32font_list, w32font_match): Use it. + (w32font_open): Don't populate subranges. + (w32font_has_char): Use script Lisp symbols, not subrange bitmask. + (w32font_encode_char): Always return unicode code-point as-is. + (w32font_text_extents): Supply a tranformation matrix to + GetGlyphOutline. Never look up by glyph index. Avoid looping + twice. Use unicode version of GetTexExtentPoint32 instead of + glyph index version. + (set_fonts_frame): Remove + (w32_enumfont_pattern_entity): Add frame parameter, use it to + set frame parameter. Use backward compatible fake foundries. + Save generic family in extra slot under QCfamily. Make width slot + constant. Save QCspacing value. Save list of scripts instead of + binary subranges. + (w32_generic_family, logfonts_match, font_matches_spec): New functions. + (add_font_entity_to_list): Use font_callback_data struct. Filter + unwanted fonts. + (add_one_font_entity_to_list): Use font_callback_data struct. + (w32_registry): Default to iso10646_1; + (fill_in_logfont): Use dpi from extra slot. Don't bother with + string font registries. Don't fill in font name if it is a generic + family name, fill family instead. Use spacing, family and script + extra info to fill pitch, family and charset fields. + (list_all_matching_fonts): Use font_callback_data struct. + (unicode_range_for_char): Remove. + (font_supported_scripts): New function. + (w32font_initialize): Remove. + (syms_of_w32font): Update which symbols are defined. + +2007-06-02 Jason Rumney <jasonr@gnu.org> + + * font.c (font_pixel_size): Reverse assq_no_quit args. + + * w32term.h (FONT_WIDTH): Report max width, not average. + (FONT_MAX_WIDTH): Remove. + (FONT_AVG_WIDTH): New macro. + + * xfaces.c (Fx_list_fonts) [WINDOWSNT]: Remove Windows only + redefinition of FONT_WIDTH. + + * w32term.c (x_font_min_bounds): Use FONT_AVG_WIDTH. + (w32_cache_char_metrics): Use FONT_WIDTH. + + * w32fns.c (w32_load_system_font, w32_list_fonts): Use FONT_AVG_WIDTH. + +2007-06-01 Jason Rumney <jasonr@gnu.org> + + * w32font.c (w32font_open): Make lfHeight negative. + + * w32fns.c (x_default_font_parameter): Use new style font name. + (Fx_create_frame, x_create_tip_frame): Initialize resx and resy. + +2007-05-31 Jason Rumney <jasonr@gnu.org> + + * w32font.c (QCsubranges): New symbol. + (w32font_open, w32font_has_char): Get subranges from subproperty + of extra. + (w32_enumfont_pattern_entity): Set subranges as subproperty of extra. + (syms_of_w32font): Define :subranges symbol. + + * font.c (font_put_extra): Expose externally. + + * font.h (font_put_extra): Moved declaration from font.c. + + * font.c (Ffont_get): Use font driver to determine otf capability. + (adjust_anchor): Check if driver defines anchor_point before using. + + * w32font.c (w32font_open): Handle size, height and pixel_size better. + (w32font_draw): Use options. + (w32_enumfont_pattern_entity): Set size to 0 for scalable fonts. + Fix detection of truetype fonts. + (registry_to_w32_charset): Handle charsets other than iso8859-1 + expressed as lisp symbols. + (w32_registry): Express charset as lisp symbol. + (fill_in_logfont): Reverse pixel and point height logic. + Don't set width here. Set quality to default. + + * w32fns.c (w32_load_system_font): Fix detecting FIXED_PITCH fonts. + (x_to_w32_font): Fill in lfPitchAndFamily correctly. + + * xterm.c (x_draw_glyph_string_foreground) [USE_FONT_BACKEND]: + Remove redundant loop and allocation. + + * makefile.w32-in (font.o, w32font.o): New objects. + (fontset.o, xdisp.o, xfaces.o, w32fns.o, w32term.o): Depend on font.h + (FONTOBJ): New group of objects conditioned on USE_FONT_BACKEND. + + * xdisp.c (fill_composite_glyph_string): Make the first arg to + STORE_XCHARB a valid l-value. + + * w32term.c (w32_native_per_char_metric): Swap width and rbearing + calculations for non-Truetype fonts. + (x_draw_glyph_string): Sync with xterm.c. + (x_draw_glyph_string_foreground) [USE_FONT_BACKEND]: Remove + redundant code. + (w32_initialize) [USE_FONT_BACKEND]: Call w32font_initialize. + + * w32term.h (w32_output_data) [USE_FONT_BACKEND]: Add fontp member. + (FRAME_FONT_OBJECT) [USE_FONT_BACKEND]: New macro from xterm.h. + + * w32fns.c [USE_FONT_BACKEND]: Port font backend changes from xfns.c. + (x_to_w32_charset, w32_to_x_charset): Expose externally. + + * w32font.c: New file for w32 font backend. + +2007-05-28 Kenichi Handa <handa@m17n.org> + + * term.c: Don't include "buffer.h" twice. + +2007-05-21 Kenichi Handa <handa@m17n.org> + + * syntax.c (skip_syntaxes): Synch with the trunk. + +2007-05-14 Kenichi Handa <handa@m17n.org> + + * character.c (Funibyte_string): New function. + (syms_of_character): Defsubr it. + +2007-05-01 Jason Rumney <jasonr@gnu.org> + + * w32term.c [USE_FONT_BACKEND]: + (x_get_font_repertory, note_mouse_movement, x_set_mouse_face_gc): + (x_set_glyph_string_clipping, x_set_glyph_string_clipping_exactly): + (x_draw_glyph_string, x_draw_glyph_string_foreground): + (x_draw_composite_glyph_string_foreground, x_new_fontset2): + (x_free_frame_resources): Sync with xterm.c. + +2007-04-29 Andreas Schwab <schwab@suse.de> + + * lread.c (read1): Use CHAR_TABLE_STANDARD_SLOTS to validate + char-table size. + +2007-04-26 Kenichi Handa <handa@m17n.org> + + * font.c (check_otf_features): Define it regardless of + HAVE_LIBOTF. + +2007-04-25 Kenichi Handa <handa@m17n.org> + + * ftfont.c (ftfont_driver): Delete font_otf_gsub and + font_otf_gpos, add font_drive_otf. + + * fontset.c (fontset_find_font): Pay attention to font size + specified for a font. + (reorder_font_vector): Check contents of font_def. + + * font.c (struct otf_list): Delete it. + (otf_list): Make it a lisp variable.. + (otf_open): Use lispy otf_list. + (generate_otf_features): Renamed from parse_gsub_gpos_spec. + (check_otf_features): New function. + (font_otf_DeviceTable, font_otf_ValueRecord, font_otf_Anchor): New + functinos. + (font_drive_otf): New function merging font_otf_gsub and + font_otf_gpos. + (font_open_for_lface): New arg spec. Change argument order. + (font_load_for_face): Adjusted for the change of + font_open_for_lface. + (Ffont_drive_otf): New function merging Ffont_otf_gsub and + Ffont_otf_gpos. + (syms_of_font): Staticpro otf_list. Delete defsubr of + Sfont_otf_gsub and Sfont_otf_gpos. Defsubr Sfont_drive_otf. + + * xfaces.c (set_font_frame_param): Adjusted for the change of + font_open_for_lface. + + * font.h (font_open_for_lface): Adjust prototype. + (struct font_driver): Delete members otf_gsub and otf_gpos, add + member otf_drive. + (font_otf_gsub, font_otf_gpos): Delete externs. + (font_drive_otf): Extern it. + +2007-04-24 Kenichi Handa <handa@m17n.org> + + * font.c (font_at): If the window W is not on a window system, + return Qnil. + + * coding.c (produce_chars): Don't call insert_from_gap if no + characters to produce. + (encode_coding): Likewise. + +2007-04-17 Kenichi Handa <handa@m17n.org> + + * fontset.c (free_realized_fontsets): Avoid unnecessary call of + Fclear_face_cache. + + * xfaces.c (face_for_font): Check also face->font==font->font.font. + +2007-04-16 Miles Bader <miles@gnu.org> + + * emacs.c (main): Change default value of `enable_font_backend' to 1. + Parse "--disable-font-backend" option. + (standard_args): Add "--disable-font-backend" option. + +2007-04-13 Kenichi Handa <handa@m17n.org> + + * fontset.c (fontset_find_font): New function. + (fontset_font): Use fontset_find_font. + (make_fontset_for_ascii_face): Don't set face ID in rfont_def. + Register the specified font for all Latin characters. + (new_fontset_from_font): Register the specified font for all Latin + characters. + (dump_fontset): For a realized fontset, include the base fontset + name in the returned vector. + +2007-04-11 Kenichi Handa <handa@m17n.org> + + * character.h (CHAR_STRING): Cast C to unsigned on calling + char_string. + + * character.c (char_string): Type of arg C changed to unsigned. + Signal an error if C is an invalid character code. + + * editfns.c (general_insert_function): Use CHARACTERP, not INTEGERP. + (Fchar_to_string): Likewise. + +2007-03-23 Kenichi Handa <handa@m17n.org> + + * character.h (MIN_MULTIBYTE_LEADING_CODE) + (MAX_MULTIBYTE_LEADING_CODE): New macros. + + * regex.c (analyse_first): Fix for multibyte characters in "case + charset:" and "case categoryspec:". + +2007-03-04 Andreas Schwab <schwab@suse.de> + + * Makefile.in (LIBES): Move standard libraries to the end. + +2007-02-27 Kenichi Handa <handa@m17n.org> + + * process.c: Cancel the change done by sync with HEAD. + +2007-02-23 Kenichi Handa <handa@m17n.org> + + * alloc.c (Fgarbage_collect): If nextb->text->inhibit_shrinking is + nonzero, don't shrink the buffer nextb. + + * buffer.h (struct buffer_text): New member inhibit_shrinking. + + * coding.c (coding_alloc_by_making_gap): New arg offset. + (alloc_destination): Call coding_alloc_by_making_gap with the arg + offset. + (decode_coding_iso_2022): Update coding->safe_charsets. + (decode_coding_gap): Temporarily set + current_buffer->text->inhibit_shrinking to 1. + +2007-02-20 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_draw_composite_glyph_string_foreground): Fix + indexing into elements of s->cmp and s->char2b. + +2007-02-16 Juanma Barranquero <lekktu@gmail.com> + + * regex.c (RE_STRING_CHAR_AND_LENGTH) [! emacs]: Add missing arg `len'. + +2007-02-16 Kenichi Handa <handa@m17n.org> + + * regex.c (GET_CHAR_BEFORE_2, GET_CHAR_AFTER): Check the variable + target_multibyte instead of multibyte. + (re_match_2_internal): Call bcmp_translate with target_multibyte. + (bcmp_translate): Change the argument name from multibyte to + target_multibyte. + +2007-02-15 Kenichi Handa <handa@m17n.org> + + These changes are to compile a regexp into a pattern that can be + used both for multibyte and unibyte targets. + + * Makefile.in (search.o): Depend on charset.h. + + * character.c (multibyte_char_to_unibyte_safe): New function. + + * search.c: Include "charset.h". + (compile_pattern_1): Delete argument multibyte. Don't set + cp->buf.target_multibyte here. Set cp->buf.charset_unibyte. + (compile_pattern): Don't compare cp->buf.target_multibyte. + Compare cp->buf.charset_unibyte. + (compile_pattern): Set cp->buf.target_multibyte. + + * lisp.h (multibyte_char_to_unibyte_safe): Extern it. + + * regex.h (struct re_pattern_buffer): New member charset_unibyte. + + * regex.c (RE_STRING_CHAR, RE_STRING_CHAR_AND_LENGTH): New arg + multibyte. Callers changed. + (RE_CHAR_TO_MULTIBYTE, RE_CHAR_TO_UNIBYTE): New macros. + (MAKE_CHAR_MULTIBYTE, MAKE_CHAR_UNIBYTE): Deleted. Callers + changed to use RE_CHAR_TO_MULTIBYTE and RE_CHAR_TO_UNIBYTE + respectively. + (SETUP_ASCII_RANGE, SETUP_UNIBYTE_RANGE): New macros. + (SETUP_MULTIBYTE_RANGE): Generate a more compact range_table. + (regex_compile): Make the compiled pattern usable both for + multibyte and unibyte targets. + (analyse_first): Make the fastmap usable both for multibyte and + unibyte targets. + (TRANSLATE_VIA_MULTIBYTE): Deleted. + (re_match_2_internal): Pay attention to the case that the + multibyteness of bufp and target may be different. + +2007-02-14 Kenichi Handa <handa@m17n.org> + + * xdisp.c (x_produce_glyphs): When a font is not found, make the + empty box occupy at least one column width. + +2007-01-30 Miles Bader <miles@gnu.org> + + * Makefile.in: Remove redundant HAVE_XFT clause. + +2006-12-20 Kenichi Handa <handa@m17n.org> + + * xrdb.c (x_load_resources): Setup the default fontSet X reource. + +2006-12-15 Kenichi Handa <handa@m17n.org> + + * regex.c (regex_compile): Synch with HEAD. + +2006-12-12 Kenichi Handa <handa@m17n.org> + + * fontset.c (Finternal_char_font): Fix previous change. + +2006-12-07 Kenichi Handa <handa@m17n.org> + + * fontset.c (Finternal_char_font): Fix for the case of POSITION + being nil. + +2006-12-06 Kenichi Handa <handa@m17n.org> + + * xftfont.c (xftfont_open): Call FcConfigSubstitute. + +2006-12-05 Kenichi Handa <handa@m17n.org> + + * xftfont.c (xftfont_open): Don't enable antialias explicitly. + +2006-11-30 Kenichi Handa <handa@m17n.org> + + * search.c (simple_search): Fix previous change. + +2006-11-29 Kenichi Handa <handa@m17n.org> + + * xftfont.c (ftfont_font_format): Extern declaration. + + * frame.c (x_set_font): Fix the second arg to fs_query_fontset. + + * xfont.c (xfont_driver): Initialize ftfont_driver.type by 0. + (xfont_list): Don't directly use Lisp_Object as an operand of &&. + + * ftfont.c (ftfont_driver): Initialize ftfont_driver.type by 0. + (ftfont_font_format): Fix previous change. + + * font.h (Ffont_xlfd_name): EXFUN it. + + * font.c (font_parse_xlfd): Fix the array size of `f'. + (register_font_driver): Use EQ to compare driver->type. + + * xfns.c (xic_create_xfontset2) [USE_FONT_BACKEND]: New function. + (create_frame_xic) [USE_FONT_BACKEND]: Call xic_create_xfontset2. + (xic_set_xfontset) [USE_FONT_BACKEND]: Likewise. + +2006-11-27 Kenichi Handa <handa@m17n.org> + + * ftfont.c (ftfont_pattern_entity): Check if FC_FONTFORMAT is + defined. + (ftfont_list_generic_family, ftfont_list, ftfont_font_format): + Likewise. + +2006-11-24 Kenichi Handa <handa@m17n.org> + + * xfont.c (xfont_open): Set font->format. + + * xftfont.c (xftfont_open): Set font->format. + + * ftfont.c (ftfont_pattern_entity): Add fontformat in a pattern. + (ftfont_list): Include FC_FONTFORMAT in FcObject. + (ftfont_open): Set font->format. + (ftfont_font_format): New function. + + * font.h (struct font): New memeber format. + + * font.c (Qopentype): New variable. + (syms_of_font): Defsym it. + (Fquery_font): Change the format of the last element of the return + value. + +2006-11-22 Kenichi Handa <handa@m17n.org> + + * search.c (simple_search): Fix sync with HEAD. + +2006-11-17 Kenichi Handa <handa@m17n.org> + + * xfns.c (xic_create_xfontset): Try the default fontset name as a + last resort. + +2006-11-08 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding_charset): Fix detection of multi-byte + charset. + +2006-11-07 Bob Halley <halley@play-bow.org> (tiny change) + + * ccl.c (ccl_driver): If DST is NULL, set ccl->produced to 0. + +2006-10-31 Kenichi Handa <handa@m17n.org> + + * xdisp.c (get_next_display_element): Set it->face_id for the + first component of a composition. + (x_produce_glyphs): Check if the font is changed or not for + composition. + +2006-10-31 Kenichi Handa <handa@m17n.org> + + (get_next_display_element): Set it->face_id for the + first component of a composition. + (x_produce_glyphs): Check if the font is changed or not for + composition. + +2006-10-30 Kenichi Handa <handa@m17n.org> + + * fontset.c (Qlatin): New variable. + (syms_of_fontset): Define it as a lisp symbol. + (Fset_fontset_font): If TARGET is `latin', use FONT_SPEC for + ASCII. + +2006-10-27 Kenichi Handa <handa@m17n.org> + + * font.c (font_unparse_fcname): Pay attention to the case that + some of font property is a null string. + +2006-10-26 Kenichi Handa <handa@m17n.org> + + * term.c: Include "composite.h". + (encode_terminal_code): Output all components of composition. + Check the size of encode_terminal_src. + (produce_glyphs): For compostion, call produce_composite_glyph. + (append_composite_glyph, produce_composite_glyph): New functions. + + * xdisp.c (x_produce_glyphs): In handling composition, if a font + is not found, get font_info from the current ascii face. + +2006-10-23 Kenichi Handa <handa@m17n.org> + + * fileio.c (Finsert_file_contents): On replacing, temporarily bind + buffer-file-name to Qnil before calling insert_from_buffer. + + * font.c (font_unparse_fcname): Pay attention to the case that + foundry is a null string. + +2006-10-17 Kenichi Handa <handa@m17n.org> + + * ftfont.c (ftfont_list): Allow registry "unicode-sip". + + * font.c (Qunicode_sip): New variable. + (syms_of_font): Declare it as a Lisp symbol. + + * font.h (Qunicode_sip): Extern it. + +2006-10-16 Kenichi Handa <handa@m17n.org> + + * composite.c (get_composition_id): Pay attention to TAB + component. + + * xterm.c (x_draw_composite_glyph_string_foreground): Don't draw + TAB. Adjusted for the change of s->char2b which always points to + the first elememnt of allocated memory. + + * xftfont.c (xftfont_text_extents): Fix calculation of descent + value. + + * xdisp.c (handle_composition_prop): Set it->c to the first + non-TAB component. + (fill_composite_glyph_string): Argument changed. + (BUILD_COMPOSITE_GLYPH_STRING): Adjusted for the above change. + (x_produce_glyphs): Fix handling of left/right padding. + +2006-10-04 Kenichi Handa <handa@m17n.org> + + * regex.c (analyse_first): Cancel the change for synching with + HEAD. + +2006-08-28 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding_system): Fix for handling off + inhibit_iso_escape_detection. Fix for the case that no coding + system is defined for a specific coding category. + +2006-08-21 Kenichi Handa <handa@m17n.org> + + * font.c (font_matching_entity): Dolete unused local var. + + * xftfont.c (xftfont_open): Call XftDefaultSubstitute before + opening a font. + + * fileio.c (Finsert_file_contents): On recovering a file, assume + Unix-like eol. + (choose_write_coding_system): On auto-saving a file, force + Unix-like eol. + + * coding.c (setup_coding_system): Fix setting of + coding->common_flags based on eol_type. + (coding_inherit_eol_type): If PARENT is not nil, be sure to + inherit from it. + +2006-08-04 Kenichi Handa <handa@m17n.org> + + * alloc.c (NSTATICS): Increased to 0x600. + +2006-08-01 Kenichi Handa <handa@m17n.org> + + * ftfont.c (ftfont_driver): Set ftfont_driver.match to + ftfont_match. + (ftfont_list): Don't check :name property. + (ftfont_match): New function. + (ftfont_pattern_entity): If the pattern doesn't contain + FC_SPACING, don't assuce FC_MONO. + + * font.h (struct font_driver): New member `match'. + (font_update_drivers): Prototype adjusted. + + * font.c (font_parse_fcname): Don't change :name property of FONT. + (font_parse_name): Likewise. + (LGSTRING_HEADER_SIZE, LGSTRING_GLYPH_SIZE, check_gstring): Define + them unconditionally. + (font_matching_entity): New function. + (font_open_by_name): Try font_matching_entity if exact match is + not found. + (font_update_drivers): Delete the arg FONT. Return a list of + actually used backends. Don't free faces, font caches here. + Don't store data in frame parameters. Don't call x_set_font. + (Ffont_spec): Store :name property as is. + (Ffont_get): Check HAVE_LIBOTF before calling font_otf_capability. + (Ffont_otf_gsub): Call font->driver->otf_gsub instead of + font_otf_gsub. + (Ffont_otf_gpos): Call font->driver->otf_gpos instead of + font_otf_gpos. + (Ffont_otf_alternates): Check if the driver has otf_gsub function. + Call font->driver->otf_gsub instead of font_otf_gsub. + + * frame.c (x_set_font_backend): Do more works that were done in + font_update_drivers before. + + * xfont.c (xfont_match): New function. + (xfont_driver): Set xfont_driver.match to xfont_match. + (xfont_draw): Set font in GC if necessary. + + * ftxfont.c (ftxfont_match): New function. + (syms_of_ftxfont): Set ftxfont_driver.match to ftxfont_match. + + * xftfont.c (xftfont_match): New function. + (syms_of_xftfont): Set xftfont_driver.match to xftfont_match. + +2006-07-28 Kenichi Handa <handa@m17n.org> + + * font.h (struct font): New member scalable. + (struct font_driver): New arg ALTERANTE_SUBST to otf_gsub. + (font_otf_gsub): Prototype adjusted. + + * font.c (font_otf_capability): Fix handling of the default + langsys. + (parse_gsub_gpos_spec): Type changed to void. New arg nbytes. + Check the contents of SPEC. + (LGSTRING_HEADER_SIZE, LGSTRING_GLYPH_SIZE): New macros. + (check_gstring): New function. + (REPLACEMENT_CHARACTER): New macro. + (font_otf_gsub): New arg alternate_subst. Be sure to set all + glyph codes of GSTRING. + (font_otf_gpos): Be sure to set all glyph codes of GSTRING. + (font_prepare_composition): Set cmp->glyph_len. + (font_open_entity): Set font->scalable. + (Ffont_get): Handle :otf property. + (Ffont_otf_gsub, Ffont_otf_gpos, Ffont_otf_alternates): New + functions. + (Fquery_font): Use font->font.full_name. + (syms_of_font): Defsubr Sfont_otf_gsub, Sfont_otf_gpos, and + Sfont_otf_alternates. + + * ftfont.c (ftfont_open): Set font->font.full_name and + font->font.name properly. Fix calculation of font->font.height + and font->min_width. + + * ftxfont.c (ftxfont_create_gcs): New function. + (ftxfont_draw_bitmap): Fix arg to ftfont_driver.get_bitmap. + (ftxfont_draw_backgrond): Fix filling region. + (ftxfont_default_fid): New function. + (ftxfont_open): Set xfotn->fid to the return value of + ftxfont_default_fid. + (ftxfont_prepare_face): Use ftxfont_create_gcs to create GCs. + (ftxfont_done_face): Free only GCs that are created by + ftxfont_create_gcs. + (ftxfont_draw): If face->gc != s->gc, create proper GCs. + + * xterm.c (x_set_glyph_string_clipping_exactly) [USE_FONT_BACKEND]: + Clip to src->width, etc (not src->clip_XXX). + + * xfns.c (x_create_tip_frame) [USE_FONT_BACKEND]: Handle + FontBackend frame parameter. + +2006-07-26 Kenichi Handa <handa@m17n.org> + + * font.h (struct font_driver_list): New member `on'. + (Fclear_font_cache): EXFUN it. + (font_update_drivers): Extern it. + + * font.c (font_unparse_fcname): Fix typo (swidth->width). + (font_list_entities): Check driver_list->on. + (register_font_driver): Initalize `on' member to 0. + (font_update_drivers): New function. + (Fclear_font_cache): Check driver_list->on. + + * frame.h (Qfont_backend): Extern it. + (x_set_font_backend): Extern it. + + * frame.c (Qfont_backend): New variable. + (frame_parms): New element for font-backend. + (x_set_font_backend): New function. + + * xfns.c (Fx_create_frame) [USE_FONT_BACKEND]: Handle + FontBackend frame parameter. + (x_frame_parm_handlers) [USE_FONT_BACKEND]: New element + x_set_font_backend. + + * xfont.c (xfont_list): Don't try listing by :name property if the + name is not for XLFD. + +2006-07-24 Kenichi Handa <handa@m17n.org> + + * font.h (LGLYPH_FROM, LGLYPH_TO, LGLYPH_SET_FROM) + (LGLYPH_SET_TO): New macros. + (LGLYPH_XOFF, LGLYPH_YOFF, LGLYPH_WADJUST): Check if adjustment + element of G is vector or not. + (font_at): Extern it. + + * font.c: Include window.h. + (font_lispy_object): New function. + (font_prepare_composition): Check LGLYPH_FORM (g) to detect the + end of valid glyph. + (font_close_object): Fix getting (struct font *). + (font_at): New function. + (Ffont_get): If FONT is a font-object, get entity from it. + (Ffont_make_gstring): Initialize elements of glyphs with nil. + (Ffont_fill_gstring): Use macro LGSTRING_XXX and LGLYPH_XXX. Fix + range check. + (Ffont_at): New function. + (syms_of_font): Defsubr Sfont_at. + + * xdisp.c (it_props): Move the entry for Qauto_composed to just + before the entry for Qcompostion. + (handle_auto_composed_prop): Call auto-composition-function with 4 + args. + (handle_composition_prop) [USE_FONT_BACKEND]: Set it->face_id from + the font in gstring. + (fill_composite_glyph_string) [USE_FONT_BACKEND]: Check + LGLYPH_FORM (g) to detect the end of valid glyph. + (x_produce_glyphs) [USE_FONT_BACKEND]: Don't update it->face_id if + we are composing with gstring. + + * xterm.c (x_draw_composite_glyph_string_foreground) [USE_FONT_BACKEND]: + Check if adjustment is vector or not. + + * Makefile.in (font.o): Make it depends on window.h. + +2006-07-24 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_draw_composite_glyph_string_foreground): Check if + adjustment is vector or not. + +2006-07-20 Kenichi Handa <handa@m17n.org> + + * casefiddle.c (casify_object): Sync with HEAD. + +2006-07-18 Miles Bader <miles@gnu.org> + + * character.h (CHECK_CHARACTER): Redefine in terms of CHECK_TYPE. + +2006-07-14 Kenichi Handa <handa@m17n.org> + + * font.h (LGLYPH_XOFF, LGLYPH_YOFF, LGLYPH_WIDTH, LGLYPH_WADJUST) + (LGLYPH_SET_WIDTH): Adjusted for the change of LGLYPH format. + (LGLYPH_ADJUSTMENT, LGLYPH_SET_ADJUSTMENT): New macros. + + * font.c (font_merge_old_spec): Treat '*' in foundry as a wild + card. + (DEVICE_DELTA): Fix typo. + (font_otf_gpos): Adjusted for the change of LGLYPH format. + (font_prepare_composition): Likewise. + + * xterm.c (x_draw_composite_glyph_string_foreground): Adjusted for + the change of LGLYPH format. + +2006-07-07 Kenichi Handa <handa@m17n.org> + + * ftfont.c (ftfont_list): Fix typo. + (ftfont_build_basic_charsets): Don't include letters with + diactrics. + +2006-07-09 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xfaces.c (realize_non_ascii_face): Set face->extra to NULL. + + * xftfont.c (xftfont_done_face): Call XftDrawDestroy only if + xftface_info is non-NULL. + +2006-07-07 Kenichi Handa <handa@m17n.org> + + * ftfont.c (ftfont_list): Fix typo. + (ftfont_build_basic_charsets): Don't include letters with + diactrics. + +2006-07-05 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * ftfont.c (ftfont_list): Move misplaced #endif + +2006-07-05 Kenichi Handa <handa@m17n.org> + + * ftfont.c (ftfont_list): Pay attention to the case that + FC_CAPABILITY is not defined. + +2006-07-03 Kenichi Handa <handa@m17n.org> + + * xftfont.c (xftfont_open): Set charset related members to -1. + + * ftfont.c (ftfont_list): Handle QCotf property. Handling of + QCname fixed. + (ftfont_open): Set charset related members to -1. + + * fontset.c (Votf_script_alist): New variable. + (syms_of_fontset): Initialize it. + (fontset_font): Delete unused variable. + + * fontset.h (Votf_script_alist): Extern it. + + * font.c (font_find_for_lface): Code optimized. + + * font.h (font_close_object, font_merge_old_spec): Extern them. + +2006-06-28 Kenichi Handa <handa@m17n.org> + + * font.c (QCscalable, Qc, Qm, Qp, Qd): New variables. + (syms_of_font): Initialize them. + (font_pixel_size): Allow float value in dpi. + (font_prop_validate_type): Deleted. + (font_prop_validate_symbol, font_prop_validate_style): Argument + changed. Caller changed. + (font_prop_validate_non_neg): Renamed from + font_prop_validate_size. + (font_prop_validate_extra): Deleted. + (font_prop_validate_spacing): New function. + (font_property_table): Add elements for all known properties. + (get_font_prop_index): Renamed from check_font_prop_name. New + argument FROM. Caller changed. + (font_prop_validate): Validate all known properties. + (font_put_extra): Argument force deleted. Caller changed. + (font_expand_wildcards): Make it static. Fix the way of shrinking + the possible range. + (font_parse_xlfd): Arguemnt merge deleted. Fix handling of RESX, + RESY, SPACING, and AVGWIDTH. Don't validate property values here. + Caller changed. + (font_unparse_xlfd): Handle dpi, spacing, and scalable properties. + (font_parse_fcname): Arguemnt merge deleted. Fix parsing of point + size. Don't validate properties values here. Caller changed. + (font_unparse_fcname): Handle dpi, spacing, and scalable + properties. + (font_open_by_name): Delete unused variable. + (Ffont_spec): Likewise. Validate property values. + (Ffont_match_p): New function. + + * font.h (QCscalable): Extern it. + (font_parse_xlfd, font_parse_fcname): Prototype adjusted. + + * ftfont.c (ftfont_list): Handle properties dpi, spacing, and + scalable. + + * xfont.c (xfont_query_font): Adjusted for the change of + font_parse_xlfd. + (xfont_list_pattern): New function. + (xfont_list): Use xfont_list_pattern. + + * xftfont.c (xftfont_prepare_face): Cancel previous change. + (xftfont_done_face): Likewise. + +2006-06-26 Kenichi Handa <handa@m17n.org> + + * font.h (Flist_fonts): EXFUN it. + +2006-06-25 Jason Rumney <jasonr@gnu.org> + + * w32term.c (w32_initialize): Add back smoothing_type and + smoothing_enabled definitions. + +2006-06-23 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_draw_glyph_string) [USE_FONT_BACKEND]: Check + s->face->font on determining underline position. + +2006-06-21 Kenichi Handa <handa@m17n.org> + + * font.c (font_parse_xlfd): Fix generating of CHARSET_REGISTRY field. + (font_has_char): Accept font-object too. + (font_find_for_lface): Try at first with a size specified in face. + + * xftfont.c (xftfont_prepare_face): Make non-ascii face share + face->extra with ascii face. + (xftfont_done_face): Don't free face->extra of non-ascii face. + +2006-06-20 Kenichi Handa <handa@m17n.org> + + * frame.c (x_set_font) [USE_FONT_BACKEND]: Fix argument to + font_open_by_name. + +2006-06-19 Kenichi Handa <handa@m17n.org> + + * font.h (QCspacing, QCdpi): Extern them. + (enum font_spacing): New enum. + (FONT_PIXEL_SIZE_QUANTUM): New macro. + + * font.c (POINT_TO_PIXEL): Don't divice POINT by 10. + (QCspacing, QCdpi): New variables. + (syms_of_font): Initialize them. + (font_pixel_size): New function. + (font_put_extra): New function. + (font_parse_xlfd): Fix handling of font size. Add QCdpi property + in FONT_EXTRA. + (font_parse_fcname): Handle enumenrated values (e.g. bold). Fix + handling font size. Add QCname property that contains only + unknown properties. + (font_score): Change argument. Caller changed. Pay attention to + FONT_PIXEL_SIZE_QUANTUM. + (font_sort_entites): Fix handling of font size. + (font_list_entities): Likewise. + (font_find_for_lface): Likewise. + (font_open_for_lface): Likewise. + (font_open_by_name): Likewise. + (Ffont_spec): Add QCname property that contains only unknown + properties. + + * ftfont.c (ftfont_list): Use assq_no_quit, not Fassq. Don't + include weight in listing pattern, instead check weight of each + listed font. Don't include scalable in pattern. Pay attention to + FONT_PIXEL_SIZE_QUANTUM. + +2006-06-19 Kenichi Handa <handa@m17n.org> + + * lread.c (read_escape): Fix the code synched with HEAD. + + * font.c (font_parse_fcname): Fix parsing of point-size. + (font_unparse_fcname): Produce symbolic names for style + properties. + (font_list_entities): Handle float size correctly. + (font_open_by_name): Prefer `normal' property values if the name + doesn't specify them. + + * fontset.c (Finternal_char_font): Use font_get_name, not + Ffont_xlfd_name. + + * ftfont.c (ftfont_pattern_entity): Use the numeric value 100 for + FC_WEIGHT_REGULAR. Exclude FC_SIZE and FC_PIXEL_SIZE from listing + pattern. Don't force scalable. + + * xftfont.c (xftfont_open): For generating a name, start from + 96-byte buffer. + +2006-06-16 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * frame.h (x_new_fontset2): Fix prototype. + +2006-06-16 Kenichi Handa <handa@m17n.org> + + * font.h (struct font_driver): Member parse_name deleted. + (font_match_p, font_get_spec, font_parse_fcname) + (font_unparse_fcname): Extern them. + (font_get_name): Prototype adjusted. + + * font.c (XLFD_SMALLNUM_MASK): Delete this macro. + (XLFD_LARGENUM_MASK): Delete XLFD_ENCODING_MASK from it. + (font_expand_wildcards): Fix handling ENCODING field. Avoid + unnecessary checks for weight, slant, and swidth. + (font_parse_fcname): New function. + (font_unparse_fcname): New function. + (font_parse_name): New function. + (font_match_p): New function. + (font_get_name): Return value changed to Lisp string. + (font_get_spec): New function. + (Qunspecified, Qignore_defface): Don't extern them. + (font_find_for_lface): Assume that LFACE is fully specified. + (font_load_for_face): If lface[LFACE_FONT_INDEX] is an font + object, use it for FACE. + (font_open_by_name): Call Ffont_spec with QCname prop. Don't call + driver->parse_name. + (Ffont_spec): Call font_parse_name, not font_parse_xlfd. + + * fontset.h (new_fontset_from_font) [USE_FONT_BACKEND]: Prototype + adjusted. + + * fontset.c (new_fontset_from_font) [USE_FONT_BACKEND]: Argument F + deleted. Don't call Fnew_fontset. Instead, directly call + make_fontset. + + * frame.h (x_new_fontset2) [USE_FONT_BACKEND]: Prototype adjusted. + + * frame.c (x_set_font) [USE_FONT_BACKEND]: Adjusted for the change + of x_new_fontset2. + + * ftfont.c (Qmonospace, Qsans_serif, Qserif, Qmono, Qsans) + (Qsans__serif): New variables. + (ftfont_generic_family_list): New variable. + (syms_of_ftfont): Initialize the above variables. + (ftfont_pattern_entity): Argument NAME deleted. + (ftfont_list_generic_family): New function. + (ftfont_parse_name): Delete this function. + (ftfont_list): Try generic family only when FcFontList found no + font. + (ftfont_list_family): Fix args to FcObjectSetBuild. + + * xfaces.c (check_lface_attrs) [USE_FONT_BACKEND]: Accept font + object in attrs[LFACE_FONT_INDEX]. + (set_lface_from_font_name): Cancel all changes for font-backend. + (set_lface_from_font_and_fontset) [USE_FONT_BACKEND]: New + function. + (Finternal_set_lisp_face_attribute) [USE_FONT_BACKEND]: Accept a + font object in QCfont attribute. + (set_font_frame_param) [USE_FONT_BACKEND]: Likewise. + (realize_default_face) [USE_FONT_BACKEND]: Call + set_lface_from_font_and_fontset. + + * xfns.c (x_default_font_parameter) [USE_FONT_BACKEND]: Try also + "fixed", and signal error here if no suitable font was found. + + * xfont.c (xfont_parse_name): Delete this function. + + * xftfont.c (xftfont_open): Change coding style of error + handling. Generate fontconfig's fontname pattern. + + * xterm.h (struct x_output) [USE_FONT_BACKEND]: New member fontp. + (FRAME_FONT_OBJECT) [USE_FONT_BACKEND]: New macro. + + * xterm.c (x_new_fontset2) [USE_FONT_BACKEND]: Change arguments. + Both args FONTSET and FONT_OBJECT must be existing ones. + +2006-06-16 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (mac_set_unicode_keystroke_event): Don't use MAKE_CHAR. + +2006-06-14 Kenichi Handa <handa@m17n.org> + + * xfont.c (xfont_open, xfont_encode_char): Fix typo. + + * font.h (struct font): Fix typo. + + * font.c (enum xlfd_field_index): Rename XLFD_XXX_SIZE_INDEX to + XLFD_XXX_INDEX. + (enum xlfd_field_mask): New enum. + (intern_font_field): Argument changed. Caller changed. If digits + are followed by non-digits, return a symbol. + (font_expand_wildcards): New function. + (font_parse_xlfd): Fix wildcard handling. + (Ffont_spec): If :name is specified, reflect the info in the other + properties. + + * ftfont.c (ftfont_pattern_entity): Fix typo. + (ftfont_list): Enforce FC_LANG in PATTERN to cancel the effect of + locale. + +2006-06-09 Kenichi Handa <handa@m17n.org> + + * font.h (Qiso8859_1, Qiso10646_1, Qunicode_bmp): Extern them. + + * font.c (Qiso8859_1, Qiso10646_1, Qunicode_bmp): Moved from + ftfont.c. + (font_unparse_xlfd): Fix argument type declaration. Append "*" if + registry doesn't specify encoding part. + (font_find_for_lface): Pay attention to LFACE_FONT_INDEX. + (font_open_by_name): At first try parsing the name. + (syms_of_font): Declare Qiso8859_1, Qiso10646_1, and Qunicode_bmp + as Lisp symbols. + + * fontset.c (reorder_font_vector): Pay attention to the case that + the 3rd element of font_def is nil. + (fontset_font): For the default fontset, append one more fontset + elements for a script-based font specification. Don't add script + attribute on finding a font. + (new_fontset_from_font): Unconditionally set FONTSET_ASCII to the + font name. + (fontset_ascii_font): If a font can't be opened, return nil. + + * ftfont.c (Qiso8859_1, Qiso10646_1, Qunicode_bmp): Moved to + font.c. + (ftfont_pattern_entity): New function. + (ftfont_get_cache): Assume that freetype_font_cache is already + initialized. + (ftfont_list): Handle the case that a file is specified in font + name. Use ftfont_pattern_entity to generate entities. + (ftfont_has_char): Check if the pattern contains FC_CHARSET. + (syms_of_ftfont): Initialize freetype_font_cache. + + * xftfont.c (xftfont_open): Make the font name fontconfig's + style. Add BLOCK_INPUT and UNBLOCK_INPUT. + (xftfont_close): Free font->font.name if not NULL. + + * xfont.c (xfont_list): If script is specified for a font, return + null_vector. + (xfont_list_family): Declare argument type. + + * xfaces.c (set_lface_from_font_name): If a font doesn't have a + name, set LFACE_FONT (lface) to nil. + + * xterm.c (x_new_fontset2): If an ASCII font couldn't be loaded, + return Qnil. + +2006-06-08 Jason Rumney <jasonr@gnu.org> + + * w32term.c (w32_initialize): Manually sync 2006-06-05 change from + HEAD. + +2006-06-08 Kenichi Handa <handa@m17n.org> + + * emacs.c (main): Check -enable-font-backend arg after the check + of -nl. + (standard_args): Add "-enable-font-backend". + + * coding.c (Ffind_operation_coding_system): Sync with HEAD. + + * callproc.c (Fcall_process): Sync with HEAD. + + * coding.h (CODING_REQUIRE_ENCODING): Comment sync with HEAD. + +2006-06-07 Kenichi Handa <handa@m17n.org> + + * xftfont.c (xftfont_default_fid): Set fid_known to 1. + (struct xftdraw_list, xftdraw_list): Delete them. + (register_xftdraw, check_xftdraw): Delete them. + (xftfont_prepare_face): Don't call register_xftdraw. + (xftfont_done_face): Don't call check_xftdraw. + (xftfont_draw): Get backroudn color only when with_background is + nonzero. + + * xfont.c (xfont_encode_char): Fix calculation of char2b. + +2006-06-06 Kenichi Handa <handa@m17n.org> + + These changes are for the new font handling codes. + + * Makefile.in (ALL_CFLAGS): Add @FREETYPE_CFLAGS@, + @FONTCONFIG_CFLAGS@, and @LIBOTF_CFLAGS@. + (LIB_X11_LIB): If HAVE_XFT is defined, set to @XFT_LIBS@. + (FONTSRC, FONTOBJ): New variables. + (obj): Add $(FONTOBJ). + (SOME_MACHINE_OBJECTS): Lib_X11_Lib. + (LIBES): Add @FREETYPE_LIBS@, @FONTCONFIG_LIBS@, and + @LIBOTF_LIBS@. + (font.o, ftfont.o, xfont.o, xftfont.o, ftxfont.o): New targets. + (fontset.o, xdisp.o, xfaces.o, xfns.o, xterm.o): Depends on + $(FONTSRC). + + * font.h, font.c, xfont.c, ftfont.c, xftfont.c, ftxfont.c: New + files. + + * character.h (Vscript_representative_chars): Extern it. + + * character.c (Vscript_representative_chars): New variable. + (syms_of_character): Declare it as a Lisp variable. + + * composite.c (get_composition_id) [USE_FONT_BACKEND]: If + enable_font_backend is nonzero, accept the composition method + COMPOSITION_WITH_GLYPH_STRING. + + * composite.h (enum composition_method) [USE_FONT_BACKEND]: New + enumeration COMPOSITION_WITH_GLYPH_STRING. + + * config.in: Re-generated. + + * dispextern.h (struct glyph_string) [USE_FONT_BACKEND]: New + members clip_x, clip_y, clip_width, and clip_height. + (struct face) [USE_FONT_BACKEND]: New members font_info and extra. + + * emacs.c (main) [USE_FONT_BACKEND]: Handle arg + --enable-font-backend. Call syms_of_font. + + * fns.c (assoc_no_quit): New function. + + * fontset.h (FONT_INFO_FROM_FACE): New macro. + (face_for_font, new_fontset_from_font) + (fontset_ascii_font) [USE_FONT_BACKEND]: Extern them. + + * fontset.c [USE_FONT_BACKEND]: Include "font.h". + (fontset_font, fontset_ascii, face_for_char) + (make_fontset_for_ascii_face, Ffont_info) + (Finternal_char_font) [USE_FONT_BACKEND]: If enable_font_backend + is nonzero, use font-backend mechanism. + (find_font_encoding): Make it non-static. + (new_fontset_from_font, fontset_ascii_font) [USE_FONT_BACKEND]: + New functions. + + * frame.h (struct frame): New members resx and resy. + (struct frame) [USE_FONT_BACKEND]: New member font_driver_list. + (x_new_fontset2) [USE_FONT_BACKEND]: Extern it. + + * frame.c [USE_FONT_BACKEND]: Include "font.h". + (make_frame, x_set_font) [USE_FONT_BACKEND]: Use font-backend + mechanism. + + * lisp.h (assoc_no_quit): Extern it. + + * xdisp.c: If USE_FONT_BACKEND is defined, include "font.h". + Through out the file, use FONT_INFO_FROM_FACE instead of + FONT_INFO_FROM_ID, use get_per_char_metric instead of + rif->per_char_metric. + (handle_composition_prop) [USE_FONT_BACKEND]: If the composition + method is COMPOSITION_WITH_GLYPH_STRING, just set it->c to ' '. + (get_glyph_face_and_encoding, fill_composite_glyph_string) + (get_char_face_and_encoding, BUILD_COMPOSITE_GLYPH_STRING) + (x_produce_glyphs) [USE_FONT_BACKEND]: If enable_font_backend is + nonzero, use font-backend mechanism. + (get_per_char_metric): New function. + + * xfaces.c [USE_FONT_BACKEND]: Include "font.h". + (set_lface_from_font_name) + (set_font_frame_param, free_realized_face) + (prepare_face_for_display, clear_face_gcs) + (Finternal_set_font_selection_order, realize_x_face) + [USE_FONT_BACKEND]: If enable_font_backend is nonzero, use + font-backend mechanism. + (clear_face_cache) [USE_FONT_BACKEND]: Don't call + clear_font_table. + (load_face_font) [USE_FONT_BACKEND]: Abort. + (face_symbolic_value, face_symbolic_weight, face_symbolic_slant) + (face_symbolic_swidth, face_for_font) [USE_FONT_BACKEND]: New + functions. + + * xfns.c [USE_FONT_BACKEND]: Include "font.h". + (x_default_font_parameter) [USE_FONT_BACKEND]: New function. + (Fx_create_frame) [USE_FONT_BACKEND]: If enable_font_backend is + nonzero, register all available font drivers. Call + x_default_font_parameter for deciding a font. + (x_create_tip_frame) [USE_FONT_BACKEND]: Likewise. + + * xterm.c [USE_FONT_BACKEND]: Include "font.h". + (x_set_mouse_face_gc, x_set_glyph_string_clipping) + (x_set_glyph_string_clipping_exactly) + (x_compute_glyph_string_overhangs) + (x_draw_glyph_string_foreground) + (x_draw_composite_glyph_string_foreground, x_draw_glyph_string) + (x_free_frame_resources) [USE_FONT_BACKEND]: If + enable_font_backend is nonzero, use font-backend mechanism. + (x_new_fontset2) [USE_FONT_BACKEND]: New function. + +2006-05-15 Kenichi Handa <handa@m17n.org> + + * coding.h (system_eol_type): Fix synching with HEAD. + + * coding.c (system_eol_type): Sync with HEAD. + (coding_inherit_eol_type): If PARENT is nil, inherit from + system_eol_type. + (syms_of_coding): Initialize system_eol_type. + + * callproc.c (Fcall_process): Sync with HEAD. + + * process.c (setup_process_coding_systems): Fix synching with + HEAD. + (read_process_output): Likewise. + (Fset_process_coding_system): Inherit system's eol format if + necessary. + + * fileio.c (choose_write_coding_system): Fix synching with HEAD. + + * keymap.c (push_key_description): Fix synching with HEAD. + +2006-05-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macgui.h (USE_ATSUI): Don't enable on emacs-unicode-2 branch. + +2006-04-07 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_eol): Pay attention to buffer relocation in + del_range_2. + (decode_coding): Call decode_eol before restoring undo_list. + +2006-03-20 Kenichi Handa <handa@m17n.org> + + * charset.c (Fdefine_charset_internal): Fix setting of + emacs_mule_bytes. + +2006-03-14 Kenichi Handa <handa@m17n.org> + + * keyboard.c (read_char): Check if C is a character or not before + looking up Vkeyboard_translate_table. + +2006-03-10 Kenichi Handa <handa@m17n.org> + + * coding.c (DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION): Fix + condition to terminate the loop. + +2006-03-09 Kenichi Handa <handa@m17n.org> + + * coding.c (produce_composition): Compare charbuf[i] instead of + args[i] against 0. + (Fterminal_coding_system): Use EQ to compare Lisp objects. + +2006-03-07 Kenichi Handa <handa@m17n.org> + + * coding.c (DECODE_COMPOSITION_START): If the source is short, set + coding->result to CODING_RESULT_INSUFFICIENT_SRC. + (decode_coding_gap): Set CODING_MODE_LAST_BLOCK after the call of + detect_coding. + (emacs_mule_char): Handle old style (Emacs 20) component character + of a composition. + (DECODE_EMACS_MULE_COMPOSITION_RULE_20): Fix parsing a composition + rule. + (DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION): Likewise. + (decode_coding_emacs_mule): Handle invalid bytes correctly. + +2006-03-04 Kenichi Handa <handa@m17n.org> + + * coding.c (encode_coding_ccl): Allocate destination dynamically + when necessary. + +2006-03-03 Kenichi Handa <handa@m17n.org> + + * ccl.c (Fccl_execute_on_string): Fix the condition of terminating + the loop. When quitted, show a proper error message. + +2006-03-02 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding): Fix previous change. + + * xterm.c (x_set_glyph_string_clipping_exactly): Set + src->clip_head and src->clip_tail temporarily instead of src->hl. + + * ccl.c (CCL_WRITE_STRING): Handle a flag bit for multibyte + character sequence. + (Fccl_execute_on_string): Use ASET, not XSET. + +2006-03-01 Kenichi Handa <handa@m17n.org> + + * search.c (search_buffer): Fix handling of "\\" in a trivial + regexp. + +2006-02-28 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding): Fix the condition of terminating the + decoding loop. + +2006-02-27 Kenichi Handa <handa@m17n.org> + + * data.c (Faset): On setting a character bigger than 255 in a + unibyte string, signal an error instead of make the string + multibyte. + +2006-02-22 Kenichi Handa <handa@m17n.org> + + * charset.c (map_charset_chars): Fix for ascii-compatible charset + made by a mapping table. + +2006-02-21 Kenichi Handa <handa@m17n.org> + + * xdisp.c (fill_composite_glyph_string): Check s->face is NULL or + not. + (BUILD_COMPOSITE_GLYPH_STRING): If C is TAB, set s->face to NULL. + (x_produce_glyphs): If CH is TAB, set cmp->offsets properly. + + * xterm.c (x_draw_composite_glyph_string_foreground): Check + s->face is NULL or not. + +2006-02-20 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_set_glyph_string_clipping_exactly): New function. + (x_draw_glyph_string): Fix drawing of right_overhang and + left_overhang around/on cursor. + + * xdisp.c (draw_glyphs): Fix inclusion of right_overwriting + glyphs. + + * term.c (produce_glyphs): Sync to HEAD. + +2006-02-15 Kenichi Handa <handa@m17n.org> + + * xdisp.c (x_produce_glyphs): Handle composition with TAB. + +2006-02-05 Kenichi Handa <handa@m17n.org> + + * coding.c: Cancel incorrect synching with HEAD. + +2006-02-03 Kenichi Handa <handa@m17n.org> + + * coding.c (Fdefine_coding_system_internal): Avoid a duplicated + element in Vcoding_system_alist. + (Fdefine_coding_system_alias): Likewise. + +2006-01-19 Kenichi Handa <handa@m17n.org> + + * xterm.c (handle_one_xevent): Handle keysyms 0x1000000..0x10000FF. + + * coding.c: Sync to HEAD for handling autoload-coding-system. + (Qcoding_system_define_form): New variable. + (syms_of_coding): Intern and staticpro it. + (Fcoding_system_p): Check Qcoding_system_define_form. + (Fcheck_coding_system): Try to autoload the definition of + CODING-SYSTEM. + + * coding.h (CODING_SYSTEM_P): If ID is not available, call + Fcoding_system_p. + (CHECK_CODING_SYSTEM): If ID is not available, call + Fcheck_coding_system. + (CHECK_CODING_SYSTEM_GET_SPEC): Try also Fcheck_coding_system. + (CHECK_CODING_SYSTEM_GET_ID): Likewise. + +2006-01-17 Kenichi Handa <handa@m17n.org> + + * xterm.c (handle_one_xevent): Delete unnecessary code inserted by + sync with HEAD. + + * coding.c (code_conversion_restore): GCPRO arg. + +2005-12-28 Kenichi Handa <handa@m17n.org> + + * character.c (lisp_string_width): Check multibyteness of STRING. + +2005-10-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (mac_encode_char): Call ccl_driver with the last arg + Qnil. Use JIS_TO_SJIS instead of ENCODE_SJIS. + (decode_mac_font_name): Use decode_coding_c_string instead of + decode_coding. + (x_load_font): Initialize fontp->fontset to -1. Set + fontp->encoding_type. + +2005-10-17 Kenichi Handa <handa@m17n.org> + + * search.c (search_buffer): Give up BM search on case-fold-search + if one of a target character has a case-equivalence of different + byte length even if that target charcter is an ASCII. + (simple_search): Fix culculation of byte length of matched text. + (boyer_moore): Fix handling of case-equivalent multibyte + characters. + +2005-10-15 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding): Fix handling of invalid bytes. + +2005-10-06 Kenichi Handa <handa@m17n.org> + + * xterm.c (handle_one_xevent): Handle keysyms directly mapped to + Unicode characters. + +2005-09-23 Kenichi Handa <handa@m17n.org> + + * coding.c (encode_coding_object): If a pre-write-conversion + function makes a new buffer, kill it. + +2005-07-29 Kenichi Handa <handa@m17n.org> + + * coding.c (QCascii_compatible_p): New variable. + (syms_of_coding): Initialize it. + (ONE_MORE_BYTE): Decrement `src' before calling string_char. + (ONE_MORE_BYTE_NO_CHECK): Likewise. + (record_conversion_result): Add `default:' case. + (coding_charset_list): Delete unused variable `coding_type'. + (Fdefine_coding_system_internal): Add `ascii-compatible-p' + property in the plist of the coding system. + (Fcoding_system_put): Check QCascii_compatible_p. + +2005-06-09 Kenichi Handa <handa@m17n.org> + + * xdisp.c (get_next_display_element): Sync with the change in + HEAD (2005-06-08). + +2005-06-06 Kenichi Handa <handa@m17n.org> + + * callproc.c (Fcall_process): Sync with the change in + HEAD (2005-06-04). + +2005-06-05 Miles Bader <miles@gnu.org> + + * xfaces.c (Finternal_lisp_face_equal_p): Restore previously + removed calculation of frame `f', as it's now used. + +2005-05-22 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (x_font_name_to_mac_font_name): Sync with trunk + for the case that does not require code conversion. + +2005-05-11 Kenichi Handa <handa@m17n.org> + + * Makefile.in (shortlisp): Cancel previous change. + (RUN_TEMACS): Include "-nl" if HAVE_SHM is defined. + (emacs${EXEEXT}): Run $(RUN_TEMACS) unconditionally. + (UNIDATA): New variable. + (${lispsource}international/charprop.el): Depends on ${UNIDATA}. + (bootstrap-emacs${EXEEXT}): Depends on charprop.el. Run + $(RUN_TEMACS) unconditionally. + +2005-05-10 Kenichi Handa <handa@m17n.org> + + * Makefile.in (shortlisp): Add ../lisp/international/charprop.el. + (temacs${EXEEXT}): Build charprop.el if necessary. + (admindir): New variable. + ($(lispsource)international/charprop.el): New target. + +2005-05-04 Miles Bader <miles@gnu.org> + + * character.c (chars-in-region): Obsolete function removed. + (syms_of_character): Remove its initialization. + +2005-04-28 Benjamin Riefenstahl <b.riefenstahl@turtle-trading.net> + + * w32select.c (validate_coding_system) + (setup_windows_coding_system): New functions. + (convert_to_handle_as_coded, Fw32_get_clipboard_data): Use + setup_windows_coding_system. + (setup_config, Fw32_get_clipboard_data): Use + validate_coding_system. + (Fx_selection_exists): Move call to setup_config to a place + were signals are allowed. + + * lisp.h (Fcoding_system_base, Fcoding_system_eol_type) + (Fcheck_coding_system): Add declarations. + +2005-04-28 Kenichi Handa <handa@m17n.org> + + * s/ms-w32.h (STDC_HEADERS): Sync with the change in + HEAD (2005-04-23). + +2005-04-25 Kenichi Handa <handa@m17n.org> + + * charset.c (load_charset_map_from_vector): Fix for the first + iteration. + +2005-04-22 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macfns.c (Fx_create_frame, x_create_tip_frame): Pass Lisp + string as the second argument for x_new_fontset. + +2005-04-18 Kenichi Handa <handa@m17n.org> + + * fns.c (Fstring_as_multibyte): Fix the change for syncing with + CVS head. + +2005-04-09 Kenichi Handa <handa@m17n.org> + + * search.c (search_buffer): Fix the change for syncing with CVS + head. + (search_buffer): Likewise. + +2005-03-31 Kenichi Handa <handa@m17n.org> + + * xdisp.c (get_next_display_element): Sync with CVS head. + +2005-03-29 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding_object): Use safe_call1 instead of call1. + (encode_coding_object): Use safe_call instead of call2. + +2005-03-14 Kenichi Handa <handa@m17n.org> + + * fontset.c (set_default_ascii_font): Fix the change for + syncing with CVS head. + +2005-01-30 Kenichi Handa <handa@m17n.org> + + * fontset.c (Fset_fontset_font): Check family element of a given + vector. + + * Makefile.in (lisp): Include charprop.el. + +2005-01-17 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macfns.c (Fx_create_frame, x_create_tip_frame): Fix crash. + Not sure if it's unnecessary. + +2005-01-16 Steven Tamm <steventamm@mac.com> + + * macfns.c (Fx_create_frame, x_create_tip_frame): ifdef'd out + some possibly unnecessary fontset checking code that crashed + when creating a new frame + +2005-01-17 Kenichi Handa <handa@m17n.org> + + * xfaces.c (merge_faces): Fix argument to lookup_derived_face and + lookup_face. + + * xdisp.c (Fformat_mode_line): Fix argument to lookup_named_face. + + * fringe.c (draw_fringe_bitmap_1): Fix argument to + lookup_named_face. + +2004-12-25 Kenichi Handa <handa@m17n.org> + + * xdisp.c (get_next_display_element): Sync to the change in HEAD + on 2004-12-21. + +2004-12-11 Kenichi Handa <handa@m17n.org> + + * search.c: Sync to the change in HEAD on 2004-11-19, 20. + + * w32console.c: Sync to the change in HEAD on 2004-12-01. + + * coding.c: Cancel the change done in HEAD on 2004-11-30. + (coding_charset_list): New function. + + * coding.h (coding_charset_list): Extern it. + + * term.c: Sync to the change in HEAD on 2004-11-30. + +2004-12-09 Kenichi Handa <handa@m17n.org> + + * fontset.c (Fset_fontset_font): Call find_font_encoding with + concatenation of family and registry. + +2004-12-06 Kenichi Handa <handa@m17n.org> + + * character.h (BYTE8_STRING): Fix typo. + + * editfns.c (Ftranslate_region_internal): Don't convert unibyte + string to multibyte (sync to HEAD). + + * casefiddle.c (casify_region): Handle changes in byte-length + using replace_range_2 (sync to HEAD). + +2004-11-24 Andreas Schwab <schwab@suse.de> + + * chartab.c (map_char_table): GCPRO table and arg. + +2004-10-29 Kenichi Handa <handa@m17n.org> + + * syntax.c (skip_syntaxes): Return lispy 0 (not nil) if point is + already at limit. + +2004-10-23 Kenichi Handa <handa@m17n.org> + + * fontset.c (fs_load_font): Use fast_string_match_ignore_case + instead of fast_c_string_match_ignore_case. + (find_font_encoding): Argument changed to Lisp_Object. Use + fast_string_match_ignore_case instead of + fast_c_string_match_ignore_case. Caller changed. + +2004-10-15 Kenichi Handa <handa@m17n.org> + + * xdisp.c (get_next_display_element): In unibyte case, decide to + display in octal form by checking a chacter by + UNIBYTE_CHAR_HAS_MULTIBYTE_P. + + * charset.c (Fset_unibyte_charset): Setup + unibyte_has_multibyte_table. + + * character.c (unibyte_has_multibyte_table): New variable. + + * character.h (unibyte_has_multibyte_table): Extern it. + (UNIBYTE_CHAR_HAS_MULTIBYTE_P): New macro. + +2004-10-14 Kenichi Handa <handa@m17n.org> + + * callproc.c (Fcall_process): Fix merging of 2004-10-13 change. + +2004-10-13 Kenichi Handa <handa@m17n.org> + + * coding.c (encode_coding_iso_2022): Fix handling of charset + annotation. + +2004-10-12 Kenichi Handa <handa@m17n.org> + + * coding.c (setup_coding_system): If coding_system is nil, use + Qundecided. + (Fterminal_coding_system): Return nil if terminal coding system is + `undecided'. + (syms_of_coding): Define coding-system `undecided' here. Setup + terminal_coding as `undecided'. + +2004-10-04 Kenichi Handa <handa@m17n.org> + + * xdisp.c (message_dolog, set_message_1): Call + unibyte_char_to_multibyte with arg type int. + + * fileio.c (Fsubstitute_in_file_name): Fix previous change. + + * lread.c (read1): Fix reading of a char-table. + + * print.c (print_object): Include sub char-table in cicularities + detection. + +2004-10-01 Kenichi Handa <handa@m17n.org> + + * keymap.c (where_is_internal_2): Fix for the case that KEY is a + cons. Append the found sequences in car of ARGS instead of + prepending. + +2004-09-28 Kenichi Handa <handa@m17n.org> + + * fileio.c (report_file_error): Make a unibyte string from + strerror (errorno). + (Fsubstitute_in_file_name): Fix the arg to + unibyte_char_to_multibyte. It is evaluated twice. + +2004-09-19 Kenichi Handa <handa@m17n.org> + + * charset.h (CHAR_CHARSET): Shortcut for ASCII case. + +2004-09-14 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding): Fix previous change. + +2004-09-13 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding_utf_16): Don't set detect_info->found if + BOM is not found. + (detect_coding): Optimization for ISO-2022 when no 8-bit data is + found. + (detect_coding_system): Likewise. + +2004-09-01 Jason Rumney <jasonr@gnu.org> + + * w32fns.c (x_to_w32_font): Update to use new coding struct. + +2004-08-17 Kenichi Handa <handa@m17n.org> + + * charset.c (Fdeclare_equiv_charset): Fix handing of CHARS. + (Fiso_charset): Likewise. + +2004-08-03 Steven Tamm <steventamm@mac.com> + + * macterm.c (mac_encode_char): Add charset argument and update + to use encoding_type. + (x_new_font,x_new_fontset): Merge in changes from xterm.c; + switch to pure fontset + (decode_mac_font_name): Temporarily remove decoding + (x_font_name_to_mac_font_name): Temporarily remove encoding + (x_load_font): Temporarily remove encoding + +2004-06-30 Kenichi Handa <handa@m17n.org> + + * xfaces.c (Fface_font): If frame is not on a window system, + ignore CHARACTER arg. If HAVE_WINDOW_SYSTEM is not defined, don't + refer to face->font. + (split_font_name_into_vector, build_font_name_from_vector) + (lookup_non_ascii_face, realize_non_ascii_face): Define them only + whne HAVE_WINDOW_SYSTEM is defined. + +2004-05-29 Kenichi Handa <handa@m17n.org> + + * xdisp.c (BUILD_GLYPH_STRINGS): Check if s is NULL. + (x_produce_glyphs): Fix setting of members of cmp in case + cmp->glyph_len is zero, + + * fontset.c (Fset_fontset_font): Docstring fixed. + (Ffontset_info): Make it backward compatible. New arg ALL. + +2004-05-11 Kim F. Storm <storm@cua.dk> + + * process.c (read_process_output): Grow decoding_buf when needed; + this could cause a crash in allocate_string and compact_small_strings. + +2004-04-29 Kenichi Handa <handa@m17n.org> + + * fileio.c (WRITE_BUF_SIZE): This macro deleted. + (e_write): Fix previous change. + +2004-04-28 Kenichi Handa <handa@m17n.org> + + * coding.c (setup_coding_system): Set coding->common_flags + correctly for raw-text. + (consume_chars): On encoding unibyte text by raw-text, don't check + multibyte form. + (encode_coding): On encoding by raw-text, never use translation + tables. + + * fileio.c (e_write): Short cut for the case of no encoding. + +2004-04-20 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding): Delete unused variables. + (detect_coding_system): Likewise. + +2004-04-18 Kenichi Handa <handa@m17n.org> + + * coding.c (encode_coding_utf_8): Fix handling of raw-byte char. + (consume_chars): Fix handling of 8-bit bytes in unibyte source. + +2004-04-14 Kenichi Handa <handa@m17n.org> + + Sync all files to HEAD. + +2004-04-14 Kenichi Handa <handa@m17n.org> + + * coding.c (Ffind_coding_systems_region_internal): Include + raw-text and no-conversion in the result. + + * fontset.h: Sync to HEAD. + + * fontset.c: Sync to HEAD. + +2004-04-14 Kenichi Handa <handa@m17n.org> + + * fontset.c (find_font_encoding): Return `ascii' for unknown + encoding. + (load_font_get_repertory): Delete unnecessary check of ENCODING of + FONT_DEF. + (font_def_arg, add_arg, from_arg, to_arg): New args. + (set_fontset_font): Argument changed. + (Fset_fontset_font): Fix for the case that TARGET is a script + name and charset name. + (new_fontset_from_font_name): Fix argument to Fnew_fontset. + +2004-04-13 Kenichi Handa <handa@m17n.org> + + * fontset.c (fontset_font): Renamed from fontset_face. Return + value changed. + (face_suitable_for_char_p): Adjusted for the change of + fontset_font. + (face_for_char): Likewise. + (make_fontset_for_ascii_face): Fix setting of the fontset element + for ASCII. + (Finternal_char_font): Use fontset_font instead of FACE_FOR_CHAR + to get a font name. + (Ffontset_info): Adjusted for the change of fontset_font. + + * composite.c: Sync to HEAD. + + * search.c: Sync to HEAD. + + * coding.c: Sync to HEAD. + (emacs_mule_char): Check invalid code more regidly. + + * coding.h: Sync to HEAD. + + * charset.c: Sync to HEAD. + + * charset.h: Sync to HEAD. + + * character.h (LEADING_CODE_LATIN_1_MIN) + (LEADING_CODE_LATIN_1_MAX): Delete these macros. + +2004-04-08 Kenichi Handa <handa@m17n.org> + + * category.h: Sync to HEAD. + + * category.c: Sync to HEAD. + + * syntax.h: Sync to HEAD. + + * syntax.c: Sync to HEAD. + + * regex.h: Sync to HEAD. + + * regex.c: Sync to HEAD. + +2004-04-07 Kenichi Handa <handa@m17n.org> + + * editfns.c: Sync to HEAD. + (check_translation): New function. + (Ftranslate_region_internal): Handle M:N mapping. + +2004-04-06 Kenichi Handa <handa@m17n.org> + + * xfaces.c (xlfd_point_size): Set font->numeric[XLFD_PIXEL_SIZE]. + +2004-03-30 Kenichi Handa <handa@m17n.org> + + * coding.c (DECODE_DESIGNATION): Set chars_96 to -1 instead of + goto invalid_code. + (decode_coding_iso_2022): Fix handling of invalid designation. + + * fileio.c (Finsert_file_contents): Be sure to call unbind_to + after calling code_conversion_save. + +2004-03-11 Kenichi Handa <handa@m17n.org> + + * xdisp.c (handle_auto_composed_prop): Fix Lisp_Object/int mixup. + + * print.c (print_prune_string_charset): Fix Lisp_Object/int mixup. + + * fontset.c: Include "intervals.h". + (fontset_face): Fix comparing of Lisp_Objects. + (free_face_fontset): Fix Lisp_Object/int mixup. + (new_fontset_from_font_name): Likewise. + + * editfns.c (Ftranslate_region_internal): Fix Lisp_Object/int mixup. + + * coding.c: Add many prototypes for static functions. + (get_translation_table): Allow max_lookup to be NULL. + (decode_coding): Call get_translation_table with max_lookup NULL. + (Ffind_coding_systems_region_internal): Likewise. + (Funencodable_char_position, Fcheck_coding_systems_region): + Likewise. + +2004-03-11 Kenichi Handa <handa@m17n.org> + + * coding.c (get_translation_table): Declare it as Lisp_Object. + (LOOKUP_TRANSLATION_TABLE): New macro. + (produce_chars): Use LOOKUP_TRANSLATION_TABLE instead of + CHAR_TABLE_REF. + (consume_chars): Likewise. + +2004-03-11 Kenichi Handa <handa@m17n.org> + + * coding.c (MAX_ANNOTATION_LENGTH): Adjusted for the change of + annotation data format. + (ADD_ANNOTATION_DATA, ADD_COMPOSITION_DATA, ADD_CHARSET_DATA): + Change arguments FROM and TO to single argument NCHARS. Caller + changed. + (decode_coding_utf_8): Pay attention to coding->charbuf_used. + (decode_coding_utf_16, decode_coding_emacs_mule) + (decode_coding_iso_2022, decode_coding_sjis, decode_coding_big5) + (decode_coding_ccl, decode_coding_charset): Likewise. + (get_translation): New function. + (produce_chars): New arguments translation_table and last_block. + Translate characters here. Return number of carryover chars. + Caller changed. + (produce_composition): New argument pos. Caller changed. + Adjusted for the change of annotation data format. + (produce_charset, produce_annotation): Likewise. + (decode_coding, encode_coding): Don't call translate_chars. + (consume_chars): New arg translation_table. Caller changed. + (translate_chars): Deleted. + (syms_of_coding): Make translation-table's number of extra slots + 2. + +2004-03-09 Kenichi Handa <handa@m17n.org> + + * search.c (simple_search): Fix setting this_pos_byte in backward + search. + + * coding.c (detect_coding_emacs_mule): Fix counting of encoded + byte sequence. + (detect_coding_ccl): Fix setting of the variable valids. + +2004-03-04 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_list_fonts): Fix the detection of an auto-scaled font. + + * coding.c (decode_coding_utf_16): Fix handling of surrogate pair. + + * editfns.c (Ftranslate_region_internal): Renamed from + Ftranslate_region. Accept a char-table in TABLE. + (syms_of_editfns): Defsubr Stranslate_region_internal. + + * xfaces.c (set_lface_from_font_name): If a font is specified for + a frame, generate a fontset from the font. + (build_scalable_font_name): If the scalable font is requested for + a specific size, don't change that size. + (try_font_list): Try a scalable font also in the case that a + pattern string is specified, + + +2004-03-03 Kenichi Handa <handa@m17n.org> + + * xfaces.c (Fface_font): New optional arg CHARACTER. + +2004-02-17 Kenichi Handa <handa@m17n.org> + + * charset.h (CHARSET_OFFSET): New macro. + +2004-02-13 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_get_font_repertory): Fix for non-Unicode-bmp charset. + + * fontset.c (fontset_face): Handle the case that repertory is a + char-table. + (find_font_encoding): Return nil for unknown encoding. + (Fset_fontset_font): Ignore a font of unknown encoding. + +2004-02-09 Kenichi Handa <handa@m17n.org> + + * keymap.c (describe_vector): Handle default value of a char + table. + + * fontset.c (fontset_face): Handle fallback fonts correctly. + (Ffontset_info): Return infomation about fallback fonts. + +2004-02-06 Kenichi Handa <handa@m17n.org> + + * fontset.c (FONTSET_DEFAULT): New macro. + (FONTSET_ADD): Handle the case that range is nil. + (fontset_add): Likewise. + (Fset_fontset_font): Change the 2nd arg name to TARGET, and handle + the case that it is nil. + (dump_fontset): Call FONTSET_DEFAULT, not FONTSET_FALLBACK. + (syms_of_fontset): Set char-table-extra-slots property of fontset + to 9. + + * charset.h (CHAR_CHARSET_P): Fix for the case that the method is + subset or superset. + +2004-01-30 Kenichi Handa <handa@m17n.org> + + * emacs.c (main): Call init_charset after syms_of_XXX. + + * charset.c (Vcharset_map_directory): Deleted. + (Vcharset_map_path): New variable + (load_charset_map_from_file): Use Vcharset_map_path instead. + (init_charset): Initialize Vcharset_map_path. + (syms_of_charset): Delete declaration of "charset-map-directory", + add declaration of "charset-map-path". + +2004-01-29 Kenichi Handa <handa@m17n.org> + + * fns.c (string_char_to_byte): Optimize for ASCII only string. + (string_byte_to_char): Likewise. + + * fileio.c (Finsert_file_contents): Avoid detecting a code twice. + + * coding.c (detect_coding_iso_2022): Fix handling of SS2 and SS3. + (detect_coding): Treat '\0' as normal ASCII byte.. + (detect_coding_system): Likewise. + +2004-01-27 Kenichi Handa <handa@m17n.org> + + * coding.h (SJIS_TO_JIS2, JIS_TO_SJIS2): New macros. + + * coding.c (QCmnemonic, QCdefalut_char) + (QCdecode_translation_table, QCencode_translation_table) + (QCpost_read_conversion, QCpre_write_conversion): New variables. + (get_translation_table): Return a list of translation tables if + necessary. + (decode_coding): Call get_translation_table with ENCODEP 0. + (char_encodable_p): If translation_table is non-nil, always call + translate_char. + (Fdefine_coding_system_internal): Accept list of translation + tables as :encode-translation-table and :decode-translation-table. + (Fcoding_system_put): New function. + (syms_of_coding): Declare new symbols. Defsubr + Scoding_system_put. + (decode_coding_sjis): Handle 4th charset (typically JISX0212). + (encode_coding_sjis): Likewise. + + * charset.c (map_charset_chars): Fix arg to map_charset_chars in + when the charset is superset type. + + * character.c (translate_char): Accept list of translation tables. + +2004-01-25 Kenichi Handa <handa@m17n.org> + + * coding.h (enum coding_attr_index): New member + coding_attr_trans_tbl. + (CODING_ATTR_TRANS_TBL): New macro. + + * coding.c (get_translation_table): New function. + (translate_chars): Fix the bug of skipping annotation data. + (decode_coding): Utilze get_translation_table. + (encode_coding): Likewise. + (char_encodable_p): Translate char if necessary. + (Funencodable_char_position): Likewise. + (Ffind_coding_systems_region_internal): Setup translation table + for encode in a coding system attribute vector in advance. + (Fcheck_coding_systems_region): Likewise. + (Fdefine_coding_system_internal): Allow a symbol as translation + table. For shift-jis type coding system, allow 4th charset. + +2004-01-24 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding_sjis): Check the first byte rigidly. + + * xdisp.c (get_next_display_element): Pass -1 as POS to + FACE_FOR_CHAR if displaying a C-string. + +2004-01-23 Kenichi Handa <handa@m17n.org> + + * composite.c (get_composition_id): Handle xoff and yoff in a + composition rule. + + * composite.h (COMPOSITION_DECODE_RULE): New arg xoff and yoff. + (struct composition): New member lbearing and rbearing. + + * xdisp.c (move_it_to): Optimize for the case (op & MOVE_TO_Y). + (x_get_glyph_overhangs): Handle a composition glyph. + (x_produce_glyphs): Setup lbearing and rbreaing for a composition + glyph. + + * xterm.c (x_compute_glyph_string_overhangs): Handle also a + composition glyph. + +2004-01-18 Kenichi Handa <handa@m17n.org> + + * print.c: Include charset.h. + (Vprint_charset_text_property): New variable. + (Qdefault): Extern it. + (PRINT_STRING_NON_CHARSET_FOUND) + (PRINT_STRING_UNSAFE_CHARSET_FOUND): New macros. + (print_check_string_result): New variable. + (print_check_string_charset_prop): New function. + (print_prune_charset_plist): New variable. + (print_prune_string_charset): New function. + (print_object): Call print_prune_string_charset if + Vprint_charset_text_property is not t. + (print_interval): Print nothing if itnerval->plist is nil. + (syms_of_print): Declare Vprint_charset_text_property as a lisp + variable. Init and staticpro print_prune_charset_plist. + +2004-01-15 Kenichi Handa <handa@m17n.org> + + * fontset.c (new_fontset_from_font_name): Use the specified font + for all characters in the new fontset. + + * macterm.c (x_set_mouse_face_gc): Call FACE_FOR_CHAR with POS and + OBJECT args. + + * xdisp.c (x_produce_glyphs): Call FACE_FOR_CHAR with POS and + OBJECT args for composition too. + + * w32term.c (x_set_mouse_face_gc): Call FACE_FOR_CHAR with POS and + OBJECT args. + +2004-01-13 Kenichi Handa <handa@m17n.org> + + * dispextern.h (FACE_FOR_CHAR): New args POS and OBJECT. + + * fontset.c (reorder_font_vector): Adjusted for the change of + FONT_DEF format. + (fontset_face): New arg id. Caller changed. + (face_for_char): New args pos and object. + (make_fontset_for_ascii_face): Adjusted for the change of FONT_DEF + format.n + (fs_query_fontset): Check NAME by Fassoc too. + (Fset_fontset_font): Allow non-XLFD font name. + (Ffontset_info): Adjusted for the change of FONT_DEF format. + + * fontset.h (face_for_char): Prototype adjusted. + + * xdisp.c (face_before_or_after_it_pos): Call FACE_FOR_CHAR with + POS and OBJECT args. + (get_next_display_element): Likewise. + (append_space): Likewise. + (extend_face_to_end_of_line): Likewise. + (get_char_face_and_encoding): Likewise. + (BUILD_COMPOSITE_GLYPH_STRING): Likewise. + (x_produce_glyphs): Likewise. + + * xfaces.c (compute_char_face): Call FACE_FOR_CHAR with + POS and OBJECT args. + + * xterm.c (x_set_mouse_face_gc): Call FACE_FOR_CHAR with + POS and OBJECT args. + +2004-01-03 Jason Rumney <jasonr@gnu.org> + + * w32select.c (Fw32_set_clipboard_data): Avoid potential realloc + of GlobalAlloc'ed memory. + +2003-12-29 Kenichi Handa <handa@m17n.org> + + * ccl.c (Fccl_execute_on_string): Fix the condition of loop. + + * charset.h (charset_table_used): Delete extern. + + * charset.c (charset_table_used): Make it static. + (map_charset_chars): Fix args to c_function with. + + * chartab.c (map_sub_char_table_for_charset): Fix args to + c_function with. + + * coding.h (enum coding_result_code): Delete + CODING_RESULT_INSUFFICIENT_CMP, add CODING_RESULT_INVALID_SRC. + + * coding.c (Qinsufficient_source, Qinconsistent_eol) + (Qinvalid_source, Qinterrupted, Qinsufficient_memory): New + variables. + (Vlast_code_conversion_error): New variables. + (syms_of_coding): DEFSYM or DEFVAR_LISP them. + (ONE_MORE_BYTE): Record error if any instead of signaling an + error. If non-ASCII multibyte char is found, return the negative + value of the code. All callers changed to check it. + (ONE_MORE_BYTE_NO_CHECK): Likewise. + (record_conversion_result): New function. All codes setting + coding->result are changed to call this function. + (detect_coding_utf_8): Don't use the local variable incomplete. + (decode_coding_utf_8): Likewise. + (emacs_mule_char): Change the second arg to `const'. + (detect_coding_emacs_mule): Don't use the local variable + incomplete. + (detect_coding_sjis): Likewise. + (detect_coding_big5): Likewise. + (decode_coding): Fix of flushing out unprocessed data. + (make_conversion_work_buffer): Fix making of a work buffer. + (decode_coding_object): Return coding->dst_object; + + * fontset.c (set_fontset_font): Fix args. + + * lisp.h (CHARACTERBITS): Define as 22. + + * process.c (send_process): Be sure to set coding->src_multibyte. + + * xdisp.c (handle_auto_composed_prop): Fix setting of limit. + +2003-12-02 Kenichi Handa <handa@m17n.org> + + * xdisp.c (handle_auto_composed_prop): Give limit to + Fnext_single_char_property_change. + +2003-12-02 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding): Fix previous change. + (detect_coding_system): Likewise. + +2003-12-02 Kenichi Handa <handa@m17n.org> + + * composite.c (syms_of_composite): Don't make the compostion hash + table week. + + * fontset.c (Fset_fontset_font): Fix docstring. + + * lisp.h (detect_coding_system): Adjust prototype. + + * fileio.c (kill_workbuf_unwind): Delete this function. + (Finsert_file_contents): Adjust the call of detect_coding_system. + Get conversion_buffer by code_conversion_save. Use the macor + CODING_MAY_REQUIRE_DECODING. After decoding, update + coding_system. + + * coding.h (make_conversion_work_buffer): Delete extern. + (code_conversion_save): Extern it. + + * coding.c (enum iso_code_class_type): Delete ISO_carriage_return. + (CODING_GET_INFO): Delete argument eol_type. Callers changed. + (decode_coding_utf_8): Don't do eol converion. + (detect_coding_utf_16): Check coding->src_chars, not + coding->src_bytes. Add heuristics for those that have no + signature. + (decode_coding_emacs_mule): Don't do eol converion. + (decode_coding_iso_2022): Likewise. + (decode_coding_sjis): Likewise. + (decode_coding_big5): Likewise. + (decode_coding_charset): Likewise. + (adjust_coding_eol_type): Return a new coding system. + (detect_coding): Don't detect eol. Fix for utf-16 detection. + (decode_eol): In case of CRLF->LF conversion, use del_range_2 on + each change. + (decode_coding): Pay attention to undo_list. Do eol convesion for + all types of coding-systems (if necessary). + (Vcode_conversion_work_buf_list): Delete it. + (Vcode_conversion_reused_workbuf): Renamed from + Vcode_conversion_reused_work_buf. + (Vcode_conversion_workbuf_name): New variable. + (reused_workbuf_in_use): New variable. + (make_conversion_work_buffer): Delete the arg DEPTH. + (code_conversion_restore): Argument changed to cons. + (code_conversion_save): Delete the argument BUFFER. Callers + changed. + (detect_coding_system): New argument src_chars. Callers changed. + Fix for utf-16 detection. + (init_coding_once): Don't use ISO_carriage_return. + (syms_of_coding): Initialized Vcode_conversion_workbuf_name and + reused_workbuf_in_use. + +2003-11-24 Kenichi Handa <handa@m17n.org> + + * keymap.c (store_in_keymap): Pay attention to the case that idx + is a cons specifying a character range. + + * coding.c (Fdefine_coding_system_internal): Fix previous change. + +2003-11-23 Kenichi Handa <handa@m17n.org> + + * xdisp.c (handle_auto_composed_prop): Fix the case of returning + HANDLED_RECOMPUTE_PROPS. + + * coding.c (Fdefine_coding_system_internal): Fix checking of + ascii compatibility. + +2003-11-22 Kenichi Handa <handa@m17n.org> + + * charset.c (find_charsets_in_text): Delete unused locale + variable. + (Fset_charset_priority): Update Vemacs_mule_charset_list too. + + * coding.c (encode_coding_emacs_mule): Emit bytes with MSB. + Resync charset_list to Vemacs_mule_charset_list. + + * keymap.c (store_in_keymap): Pay attention to the case that idx + is a cons specifying a character range. + +2003-11-18 Kenichi Handa <handa@m17n.org> + + * composite.c (update_compositions): Bind inhibit-read-only, etc + to t before calling remove-list-of-text-properties. + + * print.c (print_object): Always print ASCII chars as is. + +2003-11-17 Kenichi Handa <handa@m17n.org> + + * keymap.c (Fdefine_key): Fix handling of Lucid style event type + list. + + * fns.c (Fmapconcat): Signal an error if SEQUENCE is a char table. + (Fmapcar): Likewise. + (Fmapc): Likewise. + +2003-11-15 Kenichi Handa <handa@m17n.org> + + * syntax.c (skip_chars): Be sure to alloca char_ranges when + necessary. + +2003-11-14 Kenichi Handa <handa@m17n.org> + + * xfaces.c (set_lface_from_font_name): Fix for the case that + FONTNAME is not fontset name. + +2003-11-13 Kenichi Handa <handa@m17n.org> + + * fns.c (base64_encode_1): Fix previous change. + +2003-11-08 Kenichi Handa <handa@m17n.org> + + * fontset.c (set_fontset_font): New function. + (Fset_fontset_font): If a font is specified for a charset, use + map_charset_chars to store the font spec in a fontset. + +2003-10-29 Kenichi Handa <handa@m17n.org> + + * fontset.c (fontset_face): Create a fallback fontset on demand + (make_fontset): Don't create a fallback fontset here. + (free_face_fontset): Free a fallback fontset (if any) too. + (n_auto_fontsets): Delete this variable. + (auto_fontset_alist): New variable. + (new_fontset_from_font_name): Check auto_fontset_alist. + (dump_fontset) [FONTSET_DEBUG]: Fully re-written. + (Ffontset_list_all) [FONTSET_DEBUG]: New function. + (syms_of_fontset): Initialize and staticpro auto_fontset_alist. + Defsubr Sfontset_list_all. + +2003-10-24 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_list_fonts): Fix excluding of auto-scaled fonts. + +2003-10-23 Kenichi Handa <handa@m17n.org> + + * fontset.c (Fnew_fontset): Check NAME more rigidly. + +2003-10-17 Kenichi Handa <handa@m17n.org> + + * editfns.c (Fgoto_char): Fix docstring. + +2003-10-16 Kenichi Handa <handa@m17n.org> + + * insdel.c (insert_from_gap): Adjust intervals correctly. + +2003-10-12 Jason Rumney <jasonr@gnu.org> + + * w32term.c (GLYPHSET, WCRANGE): Define if system headers don't. + (pfnGetFontUnicodeRanges): New dynamically loaded function. + (w32_initialize): Try to load it. + (x_get_font_repertory): Use it if available. + (w32_encode_char): Add shortcut for unicode output. + + * w32fns.c (w32_load_system_font): Default charset to -1. + (x_to_w32_charset): Match all fonts for unicode. + (w32_to_x_charset): New parameter matching. Don't return partial + or wildcard charsets. + (w32_to_all_x_charsets): Don't return partial or wildcard charsets. + (w32_codepage_for_font): Return CP_UNICODE for unicode. + (w32_to_x_font): Match charset to real charset. + (enum_font_cb2): Always list unicode versions. + + * makefile.w32-in (temacs): Increase EMHEAP. + +2003-10-11 Jason Rumney <jasonr@gnu.org> + + * w32term.c (w32_encode_char): New charset parameter. + font_info.encoding becomes encoding_type. + (x_get_font_repertory): New function. Warning: stub only! + (x_new_font): Return quickly if font already set. + (x_new_fontset): fontsetname parameter is Lisp_Object. + Use new fs_query_fontset. Try new_fontset_from_font_name. Use + fontset_name for return value. + + * w32term.h: Declare x_get_font_repertory. + + * w32select.c (Fw32_set_clipboard_data): Use string_x_string_p in + place of find_charset_in_text. Use encode_coding_object in place + of encode_coding. + (Fw32_get_clipboard_data): Use decode_coding_c_string in place of + decode_coding. + + * w32fns.c (Fx_create_frame, x_create_tip_frame): Use new version + of x_new_fontset. + (w32_load_system_font): Initialize charset as unicode. + font_info.encoding becomes encoding_type. + (w32_to_x_font): Use decode_coding_c_string in place of + decode_coding. + (x_to_w32_font): Use encode_coding_object in place of + encode_coding. + (syms_of_w32fns): Set get_font_repertory_func. + + * w32console.c: Include character.h. Use terminal_encode_buffer + from term.c. + (write_glyphs): Use new version of encode_terminal_code. Use + encode_coding_object in place of encode_coding. + + * w32bdf.c (w32_load_bdf_font): Clear font_info before filling. + encoding becomes encoding_type. + + * term.c (terminal_encode_buffer): Make externally visible. + + * makefile.w32-in: Add character.h dependancies. + (character.o, chartab.o): New targets. + +2003-10-10 Kenichi Handa <handa@m17n.org> + + * fileio.c (Finsert_file_contents) [DOS_NT]: Use the macro + CODING_ID_EOL_TYPE.. + +2003-10-07 Andreas Schwab <schwab@suse.de> + + * coding.c (produce_chars): Revert last change. + +2003-10-06 Kenichi Handa <handa@m17n.org> + + * charset.h (charset_unicode): Extern it. + + * charset.c (string_xstring_p): Check by (C >= 0x100). + (find_charsets_in_text): Format of the arc CHARSETS changed. New + arg MULTIBYTE. + (Ffind_charset_region, Ffind_charset_string): Adjusted for the + change of find_charsets_in_text. + (Fsplit_char): Fix doc. Never return unknown. + + * chartab.c (char_table_translate): Use CHARACTERP, not INETEGERP. + + * coding.c (Fdefine_coding_system_alias): Update + Vcoding_system_list. + + * fontset.c (load_font_get_repertory): Pay attention to the case + that ENCODING of a font is specified by a char-table. + + * xterm.c (x_get_font_repertory): Handle the case that the + encoding of font is other than Unicode. + +2003-10-02 Kenichi Handa <handa@m17n.org> + + * term.c (encode_terminal_code): Don't handle glyph-table. Check + if a character is encodable by the terminal coding system. If + not, produces proper number of `?'s. Update + terminal_encode_buffer and terminal_encode_buf_size if necessary. + (produce_glyphs): Check by CHAR_BYTE8_P, not SINGLE_BYTE_CHAR_P. + +2003-10-01 Kenichi Handa <handa@m17n.org> + + * term.c (terminal_encode_buffer, terminal_encode_buf_size): New + variables. + (encode_terminal_code): Argument changed. Encode multiple + characters at once. Store the result of encoding in + terminal_encode_buffer. + (write_glyphs): Adjusted for the change of encode_terminal_code. + (insert_glyphs): Likewise. + (term_init): Initialize terminal_encode_buffer and + terminal_encode_buf_size. + + * coding.c (consume_chars): If coding->src_object is nil, don't + check annotation. + +2003-09-30 Kenichi Handa <handa@m17n.org> + + * character.c (char_string): Use ASCII_CHAR_P instead of + SINGLE_BYTE_CHAR_P. + +2003-09-30 Kenichi Handa <handa@m17n.org> + + * xdisp.c (handle_auto_composed_prop): Check if the last + characters of auto-composed region is newly composed with the + following characters. + (handle_composition_prop): Fix checking of point being inside + composition. + +2003-09-26 Kenichi Handa <handa@m17n.org> + + * fns.c (concat): Don't change multibyteness of the result by + concatenating an 8-bit character. + + * data.c (Faset): Check newelt by CHECK_CHARACTER. Don't change + multibyteness of the result when newelt is an 8-bit character. + +2003-09-29 Dave Love <fx@gnu.org> + + * xmenu.c (find_and_call_menu_selection): Make menu_bar_items_used + EMACS_INT. + + * xfns.c (DefaultDepthOfScreen, x_encode_text): Remove unused vars. + + * xfaces.c (face_numeric_value): Declare dim size_t. + (Finternal_lisp_face_equal_p): Remove unused f. + + * xdisp.c (BUILD_CHAR_GLYPH_STRINGS, display_and_set_cursor) + (MATRIX_ROW): Remove unused vars. + (draw_glyphs, x_insert_glyphs, fast_find_position) + (fast_find_position, fast_find_string_pos): Use EMACS_INT for + byte/char counts. + + * regex.c (regex_compile): Remove unused var. + + * minibuf.c (Fminibuffer_complete_word): Remove unused var. + + * keymap.c (Fset_keymap_parent, map_keymap, Fcopy_keymap) + (Faccessible_keymaps, where_is_internal): Remove unused vars. + + * keyboard.c (cancel_hourglass_unwind): Return Qnil. + + * frame.c (frame_name_fnn_p): Make len EMACS_INT. + + * fileio.c (Fwrite_region): Remove unused var. + + * dispnew.c (adjust_frame_glyphs_for_frame_redisplay) + (adjust_frame_glyphs_for_window_redisplay): Remove unused ch_dim. + + * composite.c (Fremove_list_of_text_properties): Declare. + + * coding.c (inhibit_pre_post_conversion): Removed (unused). + (alloc_destination, produce_chars): Use EMACS_INT for byte/char + counts. + (coding_inherit_eol_type): Remove unused attrs. + (detect_coding): Cast arg of detect_eol. + + * charset.c (syms_of_charset): Remove unused var p. + (find_charsets_in_text, Ffind_charset_region): Use EMACS_INT for + byte/char counts. + + * casetab.c (set_case_table): Remove unused var. + + * window.c (Fdisplay_buffer, Fframe_selected_window): Remove + unsued vars. + +2003-09-26 Dave Love <fx@gnu.org> + + * xterm.c (x_bitmap_mask): Declare. + +2003-09-17 Dave Love <fx@gnu.org> + + * xterm.c (x_term_init): Fix type error. + + * lisp.h: Add Funibyte_char_to_multibyte. + + * coding.c (Fread_coding_system): Fix arg of XSETSTRING. + (Fset_coding_system_priority): Doc fix. + + * alloc.c: Sync with HEAD version. + + * ccl.c (ccl_driver): Fix arg of CHARACTERP. + + * indent.c (check_composition): Make start and end EMACS_INT. + + * character.c (lisp_string_width): Make ignore and end EMACS_INT. + + * xdisp.c (handle_composition_prop, check_point_in_composition): + Make buffer positions EMACS_INT. + + * composite.c (find_composition, run_composition_function) + (update_compositions, Ffind_composition_internal): Make buffer + positions EMACS_INT. + + * composite.h (find_composition, update_compositions): Make + position args EMACS_INT. + + * keyboard.c (adjust_point_for_property): Make beg and end + EMACS_INT. + + * intervals.c (get_property_and_range): + * intervals.h (get_property_and_range): Make start and end EMACS_INT. + + * unexalpha.c: Don't include varargs.h. + +2003-09-16 Dave Love <fx@gnu.org> + + * coding.h (ENCODE_UTF_8): New. + + * Makefile.in (gtkutil.o): Depend on coding.h. + + * coding.c (Fset_coding_system_priority): Doc fix. + +2003-09-16 Kenichi Handa <handa@m17n.org> + + * fileio.c (Finsert_file_contents): Call setup_coding_system in + the case of auto saving. + +2003-09-10 Andreas Schwab <schwab@suse.de> + + * chartab.c (map_char_table): Protect `range' from GC. + (map_char_table_for_charset): Likewise. + +2003-07-09 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding_sjis): Check bytes more rigidly. + +2003-06-26 Kenichi Handa <handa@m17n.org> + + * fileio.c (choose_write_coding_system): Return a decided coding + system. + (Fwrite_region): Set Vlast_coding_system_used to the return value + of choose_write_coding_system. + +2003-06-06 Kenichi Handa <handa@m17n.org> + + * charset.c (Fset_charset_priority): Pay attention to duplicated + arguments. + + * coding.c (QCcategory): New variable. + (syms_of_coding): Defsym it. Set all elements of + Vcoding_category_table and their symbol values. + (Fset_coding_system_priority): Doc fix. Update symbol qvalues of + coding-category-XXX, and coding-category-list. + (Fdefine_coding_system_internal): Add category in the plist. + +2003-06-05 Kenichi Handa <handa@m17n.org> + + * callproc.c (Fcall_process): Handle carryover correctly. + + * coding.c (decode_coding_iso_2022): Fix handling of invalid + bytes. + (raw_text_coding_system): Check NILP (coding_system). + (coding_inherit_eol_type): Check NILP (coding_system) and + NILP (parent). + (consume_chars): Fix for the case of raw-text. + + * process.c (read_process_output): Handle carryover correctly. + +2003-06-02 Dave Love <fx@gnu.org> + + * regex.c (re_search_2): Fix last change. + +2003-05-30 Kenichi Handa <handa@m17n.org> + + * regex.c (GET_CHAR_BEFORE_2): Check multibyte, not + target_multibyte. Even in a unibyte case, return a converted + multibyte char. + (GET_CHAR_AFTER): New macro. + (PATFETCH): Translate via multibyte char. + (HANDLE_UNIBYTE_RANGE): Delete this macro. + (SETUP_MULTIBYTE_RANGE): New macro. + (regex_compile): Setup compiled code so that its multibyteness + matches that of a target. Fix the handling of "[X-YZ]" using + SETUP_MULTIBYTE_RANGE. + (analyse_first) <charset>: For filling fastmap for all multibyte + characters, don't check by BASE_LEADING_CODE_P. + (re_search_2): Don't check RE_TARGET_MULTIBYTE_P (bufp). It is + the same as RE_MULTIBYTE_P (bufp) now. + (mutually_exclusive_p): Check by (! multibyte || + IS_REAL_ASCII (c)). + (TARGET_CHAR_AND_LENGTH): Delete this macro. + (TRANSLATE_VIA_MULTIBYTE): New macro. + (re_match_2_internal): Don't check RE_TARGET_MULTIBYTE_P (bufp). + It is the same as RE_MULTIBYTE_P (bufp) now. + <exactn>: Translate via multibyte. + <anychar>: Fetch a character by RE_STRING_CHAR_AND_LENGTH. Don't + translate it. + <charset, charset_not>: Fetch a character by + RE_STRING_CHAR_AND_LENGTH. Translate via multibyte. + <duplicate>: Call bcmp_translate with the last arg `multibyte'. + <wordbound, notwordbound, wordbeg, wordend, syntaxspec, + notsyntaxspec, categoryspec, notcategoryspec> Fetch a character + by GET_CHAR_AFTER. + (bcmp_translate): Likewise. + + * search.c (compile_pattern): Check the member target_multibyte, + not the member multibyte of buf. + + * lread.c (read1): While reading a string, set force_singlebyte + and force_multibyte correctly. + + * charset.c (Fset_unibyte_charset): Fix setting up of + unibyte_to_multibyte_table. + (init_charset_once): Likewise. + +2003-05-29 Kenichi Handa <handa@m17n.org> + + * coding.c (setup_coding_system): If coding has + post-read-conversion or pre-write-conversion, set + CODING_REQUIRE_DECODING_MASK and CODING_REQUIRE_ENCODING_MASK + respectively. + (decode_coding_gap): Run post-read-conversion if any. + + * fileio.c (Finsert_file_contents): Even if we read into a + unibyte buffer, check if we must decode the result or not. + +2003-05-29 Kenichi Handa <handa@m17n.org> + + * coding.c (make_conversion_work_buffer): Change the work buffer + name to the same one as that of Emacs 21. + +2003-05-28 Kenichi Handa <handa@m17n.org> + + * coding.h (make_conversion_work_buffer): Prototype adjusted. + (code_conversion_restore): Don't extern it. + + * coding.c (detected_mask): Delete unused variable. + (decode_coding_iso_2022): Pay attention to the byte sequence of + CTEXT extended segment, and retain those bytes as is. + (decode_coding_ccl): Delete unused variable `valids'. + (setup_coding_system): Delete unused variable `category'. + (consume_chars): Delete unused variable `category'. Make it work + for non-multibyte case. + (make_conversion_work_buffer): Argument changed. + (saved_coding): Delete unused variable. + (code_conversion_restore): Don't check saved_coding->destination. + (code_conversion_save): New function. + (decode_coding_gap, encode_coding_gap): Call code_conversion_save + instead of record_unwind_protect. + (decode_coding_object, encode_coding_object): Likewise. Recover + PT. + (detect_coding_system): Delete unused variable `mask'. + (Fdefine_coding_system_internal): Delete unsed vaiable id; + + * fileio.c (kill_workbuf_unwind): New function. + (Finsert_file_contents): On replacing, call + make_conversion_work_buffer with correct args, and call + record_unwind_protect with the first arg kill_workbuf_unwind. + + * lisp.h (Fgenerate_new_buffer_name): EXFUN it. + +2003-05-20 Kenichi Handa <handa@m17n.org> + + * fontset.c (BASE_FONTSET_P): Check FONTSET_BASE, not + FONTSET_NAME. + (fontset_add): Fix for the case that TO is less than TO1. + (Ffontset_info): Don't use fallback fontset on checking the + default fontset. + (dump_fontset): New function for debugging. + + * coding.c (Fdefine_coding_system_internal): Fix for the case that + coding_type is Qcharset. + +2003-05-07 Kenichi Handa <handa@m17n.org> + + * chartab.c (map_sub_char_table): New argument DEFAULT_VAL. + (map_char_table): Don't inherit the value from the parent on + initializing VAL. Adjusted for the above change. + +2003-05-06 Kenichi Handa <handa@m17n.org> + + * coding.c (Qsignature, Qendian): Delete these variables. + (syms_of_coding): Don't initialize them. + (CATEGORY_MASK_UTF_16_AUTO): New macro. + (detect_coding_utf_16): Add CATEGORY_MASK_UTF_16_AUTO in + detect_info->found. + (decode_coding_utf_16): Don't detect BOM here. + (encode_coding_utf_16): Produce BOM if CODING_UTF_16_BOM (coding) + is NOT utf_16_without_bom. + (setup_coding_system): For a coding system of type utf-16, check + if the attribute :endian is Qbig or not (not nil or not), and set + CODING_REQUIRE_DETECTION_MASK if BOM detection is required. + (detect_coding): If coding type is utf-16 and BOM detection is + required, detect it. + (Fdefine_coding_system_internal): For a coding system of type + utf-16, check if the attribute :endian is Qbig or not (not nil or + not). + +2003-05-06 Kenichi Handa <handa@m17n.org> + + * coding.c (coding_set_source): Fix for the case that the current + buffer is different from coding->src_object. + (decode_coding_object): Don't use the conversion work buffer if + DST_OBJECT is a buffer. + +2003-05-04 Dave Love <fx@gnu.org> + + * lread.c (read_emacs_mule_char) [len==2]: Index + emacs_mule_charset correctly. + +2003-02-16 Dave Love <fx@gnu.org> + + * coding.c (Qbig5, Vbig5_coding_system, CATEGORY_MASK_BIG5) + (detect_coding_big5, decode_coding_big5, encode_coding_big5) + (Fdecode_big5_char, Fencode_big5_char): Deleted. (Big5 no longer + treated specially.) + (setup_coding_system, coding_category, CATEGORY_MASK_ANY) + (detected_mask): Remove Big5 bits. + +2003-04-09 Kenichi Handa <handa@m17n.org> + + The following changes are to make the font rescaling facility + compatible with Emacs 21. + + * xfaces.c (Vface_font_rescale_alist): Renamed from + Vface_resizing_fonts. + (struct font_name): Rename member resizing_ratio to rescale_ratio. + (font_rescale_ratio): Renamed from font_resizing_ratio. + (split_font_name): Set font->rescale_ratio. + (better_font_p): Pay attention to font->rescale_ratio. + (build_scalable_font_name): Likewise. Change RESX, and RESY + fields. + (syms_of_xfaces): Declare Vface_font_rescale_alist as a Lisp + variable. + +2003-03-28 Kenichi Handa <handa@m17n.org> + + * coding.c (Qutf_16_be_nosig, Qutf_16_be, Qutf_16_le_nosig) + (Qutf_16_le): Remove these variables. + (syms_of_coding): Don't DEFSYM them. + (decode_coding_utf_16): Fix handling of BOM. + (encode_coding_utf_16): Fix handling of BOM. + +2003-03-14 Kenichi Handa <handa@m17n.org> + + * fileio.c (Finsert_file_contents): On replacing, before decoding + the file into the work buffer, set point of the work buffer to the + end. + +2003-02-13 Dave Love <fx@gnu.org> + + * coding.c (Fcheck_coding_systems_region): Fix type errors. + +2003-02-04 Dave Love <fx@gnu.org> + + * xterm.c (XTread_socket): Check Lisp types for Vx_keysym_table + and fix C types. + +2003-01-31 Kenichi Handa <handa@m17n.org> + + * xdisp.c (SKIP_GLYPHS): New macro. + (set_cursor_from_row): Pay attention to string display properties. + + * category.c (copy_category_entry): Fix for the case that RANGE + is an integer. + + * xterm.c (x_encode_char): Call ccl_driver with the last arg Qnil. + + * w32term.c (w32_encode_char): Call ccl_driver with the last arg + Qnil. + +2003-01-30 Kenichi Handa <handa@m17n.org> + + * charset.c (Fcharset_id_internal): New function. + (syms_of_charset): Defsubr it. + + * coding.c (decode_coding_ccl, encode_coding_ccl): Call ccl_driver + with the last arg charset_list acquired from coding. + (Fdefine_coding_system_internal): For ccl-based coding system, fix + the attribute coding_attr_ccl_valids. + + * coding.h (enum define_coding_ccl_arg_index): Set the first + member coding_arg_ccl_decoder to coding_arg_max. + + * ccl.h (ccl_driver): Prototype adjusted. + + * ccl.c (CCL_DECODE_CHAR, CCL_ENCODE_CHAR): New macros. + (ccl_driver): New arg CHARSET_LIST. Use the above macros instead + of DECODE_CAHR, ENCODE_CHAR, CHAR_CHARSET. + (Fccl_execute): Call ccl_driver with the last arg Qnil. + (Fccl_execute_on_string): Likewise. + +2003-01-11 Kenichi Handa <handa@m17n.org> + + * charset.h (ENCODE_CHAR): If the method is SUBSET or SUPERSET, + call encode_char. + + * charset.c (encode_char): Fix handling of methods SUBSET and + SUPERSET. + + * xterm.c (x_new_fontset): Fix previous change. + +2003-01-10 Dave Love <fx@gnu.org> + + * composite.c (syms_of_composite): Make composition_hash_table + weak. + +2003-01-10 Kenichi Handa <handa@m17n.org> + + * dispextern.h (check_face_attributes, generate_ascii_font_name) + (font_name_registry): Don't extern them. + (split_font_name_into_vector, build_font_name_from_vector): Extern + them. + + * fontset.h (Qfontset): Don't extern it. + (new_fontset_from_font_name): Extern it. + + * fontset.c: Give 8 extra slots to fontset objects. + (Qfontset_info): New variable. + (syms_of_fontset): Defsym it. + (FONTSET_FALLBACK): New macro. + (fontset_face): Try also the default fontset. + (make_fontset): Realize a fallback fontset from the default + fontset. + (generate_ascii_font_name): Moved from xfaces.c. Rewritten by + using split_font_name_into_vector and build_font_name_from_vector. + (Fset_fontset_font): Access the elements of font_spec by enum + FONT_SPEC_INDEX. If font_spec is a string, extract the registry + name by using split_font_name_into_vector. + (Fnew_fontset): If no ASCII font is specified in FONTLIST, + generate a proper font name from the fontset name. Update + Vfontset_alias_alist. + (n_auto_fontsets): New variable. + (new_fontset_from_font_name): New function. + (Ffont_info): Store the information about fonts generated from the + default fontset in the first extra slot of the returned + char-table. + + * xfaces.c (generate_ascii_font_name): Moved to fontset.c. + (font_name_registry): Function deleted. + (split_font_name_into_vector): New function. + (build_font_name_from_vector): New function. + (font_list): The argument REGISTRY is now a list of registry + names. + (choose_face_font): If we are choosing an ASCII font, and ATTRS + specifies an explicit font name, return the name as is. Make a + list of registy names. + + * xfns.c (x_set_font, x_create_tip_frame): Adjusted to the change + of x_new_fontset. + (Fx_create_frame): Don't call x_new_fontset here. Just use + x_list_fonts to check the existence of fonts. + + * xterm.h (x_new_fontset): Prototype adjusted. + + * xterm.c (x_new_fontset): Change the arg FONTSETNAME to Lisp + string. Use new_fontset_from_font_name to create a fontset from a + font name. + +2003-01-07 Dave Love <fx@gnu.org> + + * Makefile.in: Fix some dependencies. + + * keymap.c (Fapropos_internal): Don't gcpro apropos_predicate but + set it to nil before returning. + + * composite.c (update_compositions): Fix type error. + + * syntax.c (skip_chars, skip_syntaxes): Fix type errors. + +2003-01-07 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_new_font): Optimize for the case that the font is + already set for the frame. + +2003-01-06 Kenichi Handa <handa@m17n.org> + + * chartab.c (char_table_ascii): Check if the char table contents + is sub-char-table or not. + (char_table_set): Fix argument to char_table_ascii. + (char_table_set_range): Likewise. + + * coding.c (CATEGORY_MASK_RAW_TEXT): New macro. + (detect_coding_utf_8, detect_coding_utf_16) + (detect_coding_emacs_mule, detect_coding_iso_2022) + (detect_coding_sjis, detect_coding_big5) + (detect_coding_ccl, detect_coding_charset): Change argument MASK + to DETECT_INFO. Update DETECT_INFO and return 1 if the byte + sequence is valid in this coding system. Callers changed. + (MAX_ANNOTATION_LENGTH): New macro. + (ADD_ANNOTATION_DATA): New macro. + (ADD_COMPOSITION_DATA): Argument changed. Callers changed. Call + ADD_ANNOTATION_DATA. The format of annotation data changed. + (ADD_CHARSET_DATA): New macro. + (emacs_mule_char): New argument ID. Callers changed. + (decode_coding_emacs_mule, decode_coding_iso_2022) + (decode_coding_sjis, decode_coding_big5, decode_coding_charset): + Produce charset annotation data in coding->charbuf. + (encode_coding_emacs_mule, encode_coding_iso_2022): Pay attention + to charset annotation data in coding->charbuf. + (setup_coding_system): Add CODING_ANNOTATE_CHARSET_MASK + coding->common_flags if the coding system is iso-2022 based and + uses designation. + (produce_composition): Adjusted for the new annotation data + format. + (produce_charset): New function. + (produce_annotation): Handle charset annotation. + (handle_composition_annotation, handle_charset_annotation): New + functions. + (consume_chars): Handle charset annotation. Utilize the above two + functions. + (encode_coding_object): If SRC_OBJECT and DST_OBJECT are the same + buffer, get the deleted text as a string and set + coding->src_object to that string. + (detect_coding, detect_coding_system): Use the new struct + coding_detection_info. + + * coding.h (struct coding_detection_info): New structure. + (struct coding_system): Prototype of the member `detector' + adjusted. + (CODING_ANNOTATE_CHARSET_MASK): New macro. + +2003-01-06 Kenichi Handa <handa@m17n.org> + + * insdel.c (insert_from_gap): Fix argument to offset_intervals. + +2003-01-03 Dave Love <fx@gnu.org> + + * keymap.c (apropos_predicate, apropos_accumulate): Declare + static. + (Fapropos_internal): Don't gcpro apropos_accumulate. Set result + to new local and nullify apropos_accumulate before returning. + (syms_of_keymap): Staticpro and initialize apropos_accumulate. + +2002-12-05 Kenichi Handa <handa@m17n.org> + + * charset.c (Fdefine_charset_internal): Setup charset.fast_map + correctly. + +2002-11-26 Dave Love <fx@gnu.org> + + * fns.c (Flanginfo): Call synchronize_system_time_locale. + +2002-11-07 Kenichi Handa <handa@m17n.org> + + The following changes are to make character composition happen + automatically on displaying. + + * Makefile.in (lisp, shortlisp): Add composite.elc + + * composite.h (Qauto_composed, Vauto_composition_function, + Qauto_composition_function): Extern them. + + * composite.c (Vcomposition_function_table, + Qcomposition_function_table): Delete variables. + (Qauto_composed, Vauto_composition_function, + Qauto_composition_function): New variables. + (run_composition_function): Don't call + compose-chars-after-function. + (update_compositions): Clear `auto-composed' text property. + (compose_chars_in_text): Delete this function. + (syms_of_composite): Staticpro Qauto_composed and + Qauto_composition_function. Declare Vauto_composition_function as + a Lisp variable. + + * dispextern.h (enum prop_idx): Add member AUTO_COMPOSED_PROP_IDX. + + * xdisp.c (it_props): Add an entry for Qauto_composed. + (handle_auto_composed_prop): New function. + + * xselect.c (selection_data_to_lisp_data): Don't call + compose_chars_in_text. + +2002-11-06 Dave Love <fx@gnu.org> + + * keyboard.c (read_char): Modify checking around use of + Vkeyboard_translate_table. + + * xterm.c (XTread_socket): Check Lisp types for Vx_keysym_table + and fix C types. + +2002-11-06 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding_utf_8): When eol_type is Qdos, handle + the case that the last byte is '\r' correctly. + (decode_coding_emacs_mule): Likewise. + (decode_coding_iso_2022): Likewise. + (decode_coding_sjis): Likewise. + (decode_coding_big5): Likewise. + (decode_coding_charset): Likewise. + (produce_chars): Likewise. + (decode_coding): Flushing out the unprocessed data correctly. + (decode_coding_gap): Set CODING_MODE_LAST_BLOCK bit of + coding->mode. + +2002-10-31 Dave Love <fx@gnu.org> + + * xterm.c (XTread_socket): Fix changes for defined keysyms. Add + XK_ISO... case. + (xaw_scroll_callback): Revert last change. + +2002-10-30 Kenichi Handa <handa@m17n.org> + + * charset.c (Fset_charset_priority): Update + Viso_2022_charset_list. + +2002-10-29 Kenichi Handa <handa@m17n.org> + + * xfaces.c (Vface_resizing_fonts): New variable. + (struct font_name): New member `resizing_ratio'. + (font_resizing_ratio): New function. + (split_font_name): Set font->resizing_ratio. + (better_font_p): Pay attention to font->resizing_ratio. + (build_scalable_font_name): Likewise. Don't change POINT_SIZE, + RESX, and RESY fields. + (try_alternative_families): Try scalable fonts if + Vscalable_fonts_allowed is not Qt. + (syms_of_xfaces): Declare Vface_resizing_fonts as a Lisp variable. + +2002-10-29 Dave Love <fx@gnu.org> + + * xterm.c (xaw_scroll_callback): Cast correctly. + +2002-10-28 Dave Love <fx@gnu.org> + + * keyboard.c (lispy_accent_codes, lispy_accent_keys): Extend. + (lispy_kana_keys): Comment out. + (make_lispy_event) [XK_kana_A]: Comment out. + + * xterm.c (xaw_scroll_callback): Cast call_data. + (XTread_socket): Deal with ASCII keysyms. + (syms_of_xterm) <Vx_keysym_table>: Fix args of make_hash_table. + +2002-10-27 Dave Love <fx@gnu.org> + + * xterm.c (Vx_keysym_table): New. + (syms_of_xterm): Initialize it. + (XTread_socket): Use it. + From head: Eliminate incorrect optimization that tried to avoid + decoding the output of X*LookupString. + (x_get_font_repertory): Delete charset declaration. + +2002-10-16 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding): Fix previous change. + (detect_coding_charset): If only ASCII bytes are found, return 0. + (detect_coding_system): Fix previous change. + (Fdefine_coding_system_internal): Setup + CODING_ATTR_ASCII_COMPAT (attrs) correctly. + +2002-10-15 Dave Love <fx@gnu.org> + + * coding.c (Fcheck_coding_system): Doc fix. + + * editfns.c (Finsert_byte): Return a proper value. + +2002-10-14 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding): Fix args to translate_chars. Pay + attention to Vstandard_translation_table_for_decode. + (encode_coding): Fix args to translate_chars. Pay attention to + Vstandard_translation_table_for_encode. + + * data.c (Faset): Check NEWELT by ASCII_CHAR_P, not by + SINGLE_BYTE_CHAR_P. + + * editfns.c (general_insert_function): Check VAL by ASCII_CHAR_P, + not by SINGLE_BYTE_CHAR_P. + + * fns.c (concat): Check CH by ASCII_CHAR_P, not by + SINGLE_BYTE_CHAR_P. + + * insdel.c (copy_text): Check C by ASCII_CHAR_P, not by + SINGLE_BYTE_CHAR_P. + + * keymap.c (Ftext_char_description): Check C by ASCII_CHAR_P, not + by SINGLE_BYTE_CHAR_P. + + * search.c (Freplace_match): Check C by ASCII_CHAR_P, not by + SINGLE_BYTE_CHAR_P. + +2002-10-14 Dave Love <fx@gnu.org> + + * fns.c (Fstring_as_multibyte, Fstring_to_multibyte): Doc fix. + +2002-10-10 Dave Love <fx@gnu.org> + + * fns.c (Flanginfo): Fix typo. + + * unexelf.c (unexec): Make last change conditional on Irix 6.5. + +2002-10-10 Kenichi Handa <handa@m17n.org> + + * coding.c (detect_coding_utf_8): Check incomplete byte sequence. + Don't update *mask when correctly detected. + (detect_coding_utf_16): Likewise. + (detect_coding_emacs_mule): Likewise. + (detect_coding_iso_2022): Likewise. + (detect_coding_sjis): Likewise. + (detect_coding_big5): Likewise. + (detect_coding_ccl): Likewise. + (decode_coding_sjis): Fix decoding of katakana-jisx0201. + (detect_eol): Delete the argument CODING, and add the argument + CATEGORY. + (detect_coding): Adjusted for the changes above. + (detect_coding_system): Likewise. + +2002-10-09 Kenichi Handa <handa@m17n.org> + + * character.c (char_string): Renamed from + char_string_with_unification. Pay attention to + CHAR_MODIFIER_MASK. + (string_char): Renamed from string_char. + + * character.h (CHAR_STRING): Call char_string if C is greater than + MAX_3_BYTE_CHAR. + (CHAR_STRING_ADVANCE): Likewise. + (STRING_CHAR): Call string_char instead of + string_char_with_unification. + (STRING_CHAR_AND_LENGTH): Likewise. + (STRING_CHAR_ADVANCE): Likewise. + +2002-10-09 Dave Love <fx@gnu.org> + + * coding.c (decode_coding_utf_8): Treat surrogates as invalid. + +2002-10-07 Kenichi Handa <handa@m17n.org> + + * keymap.c (push_key_description): Pay attention to + force_multibyte. + + * regex.c (re_search_2): Fix for the case of unibyte buffer. + +2002-10-06 Dave Love <fx@gnu.org> + + * charset.c (define_charset_internal): Rename `supprementary'. + + * Makefile.in (lisp, shortlisp): Remove latin-N. + +2002-10-05 Dave Love <fx@gnu.org> + + * xfns.c (x_window, x_window): Use use_xim. + + * xterm.c (use_xim): Initialize. + (xim_open_dpy, xim_initialize, xim_close_dpy): Use use_xim. + (x_term_init): Maybe set use_xim. + + * xterm.h (use_xim) [HAVE_X_I18N]: Declare. + +2002-10-01 Kenichi Handa <handa@m17n.org> + + * search.c (search_buffer): Fix case-fold-search of multibyte + characters. + (boyer_moore): Rename the last argument to char_high_bits. + +2002-09-27 Kenichi Handa <handa@m17n.org> + + * xdisp.c (display_string): Fix for the case of zero width glyph. + + * xfns.c (x_set_font): Change the error message of the case that + x_new_fontset returns Qt. + + * xfaces.c (set_lface_from_font_name): Reject the default fontset. + (Finternal_set_lisp_face_attribute): Use signal_error for the + error of invalid fontset. + + * xterm.c (x_new_fontset): If FONTSETNAME specifies the default + fontset, return Qt. + +2002-09-19 Kenichi Handa <handa@m17n.org> + + * regex.c (re_search_2): Fix previous change. + +2002-09-18 Kenichi Handa <handa@m17n.org> + + * syntax.c (skip_syntaxes): Fix previous change. + +2002-09-13 Kenichi Handa <handa@m17n.org> + + * syntax.c (skip_chars): Fix previous change. + (skip_syntaxes): Fix previous change. + +2002-09-06 Dave Love <fx@gnu.org> + + * config.in: Restore it. + +2002-09-05 Dave Love <fx@gnu.org> + + * config.in: Removed (now auto-generated). + + * s/usg5-4.h: Fix last change. + + * unexelf.c (unexec): Make .got handling not SGI-specific. + + * syntax.c (syms_of_syntax) <multibyte-syntax-as-symbol>: Doc fix. + + * regex.c: Use `ifdef HAVE_ALLOCA_H', not `if HAVE_ALLOCA_H'. + + * keyboard.c (read_key_sequence): Fix type error. + + * buffer.c (Fset_buffer_multibyte, Fset_buffer_multibyte): Fix + type error. + + * fontset.c (fontset_add): Return Lisp_Object. + +2002-09-03 Dave Love <fx@gnu.org> + + * charset.h (charset_ordered_list_tick): Declare extern. + +2002-09-03 Kenichi Handa <handa@m17n.org> + + The following changes (and some of 2002-08-20 changes of mine) are + for handling syntax, category, and case conversion for unibyte + characters by converting them to multibyte on the fly. With these + changes, we don't have to setup syntax and case tables for unibyte + characters in each language environment. + + * abbrev.c (Fexpand_abbrev): Convert a unibyte character to + multibyte if necessary. + + * bytecode.c (Fbyte_code): Likewise. + + * character.h (LEADING_CODE_LATIN_1_MIN) + (LEADING_CODE_LATIN_1_MAX): New macros. + (unibyte_to_multibyte_table): Extern it. + (unibyte_char_to_multibyte): New macro. + (MAKE_CHAR_MULTIBYTE): Use unibyte_to_multibyte_table. + (CHAR_LEADING_CODE): New macro. + (FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE): New macro. + + * character.c (unibyte_to_multibyte_table): New variable. + (unibyte_char_to_multibyte): Move to character.h and defined as + macro. + (multibyte_char_to_unibyte): If C is an eight-bit character, + convert it to the corresponding byte value. + + * charset.c (Fset_unibyte_charset): If the dimension of CHARSET is + not 1, singals an error. Update the elements of + unibyte_to_multibyte_table. + (init_charset_once): Initialize unibyte_to_multibyte_table. + (syms_of_charset): Define the charset `iso-8859-1'. + + * casefiddle.c (casify_object): Fix previous change. + + * cmds.c (internal_self_insert): In a multibyte buffer, insert C + as is without converting it to unibyte. In a unibyte buffer, + convert C to multibyte before checking the syntax. + + * lisp.h (unibyte_char_to_multibyte): Extern deleted. + + * minibuf.c (Fminibuffer_complete_word): Use the macro + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE. + + * regex.h (struct re_pattern_buffer): New member target_multibyte. + + * regex.c (RE_TARGET_MULTIBYTE_P): New macro. + (GET_CHAR_BEFORE_2): Check target_multibyte, not multibyte. If + that is zero, convert an eight-bit char to multibyte. + (MAKE_CHAR_MULTIBYTE, CHAR_LEADING_CODE): New dummy new macros for + non-emacs case. + (PATFETCH): Convert an eight-bit char to multibyte. + (HANDLE_UNIBYTE_RANGE): New macro. + (regex_compile): Setup the compiled pattern for multibyte chars + even if the given regex string is unibyte. Use PATFETCH_RAW + instead of PATFETCH in many places. To handle `charset' + specification of unibyte, call HANDLE_UNIBYTE_RANGE. Use bitmap + only for ASCII chars. + (analyse_first) <exactn>: Simplified because the compiled pattern + is multibyte. + <charset_not>: Setup fastmap from bitmap only for ASCII chars. + <charset>: Use CHAR_LEADING_CODE to get leading codes. + <categoryspec>: If multibyte, setup fastmap only for ASCII chars + here. + (re_compile_fastmap) [emacs]: Call analyse_first with the arg + multibyte always 1. + (re_search_2): In emacs, set the locale variable multibyte to 1, + otherwise to 0. New local variable target_multibyte. Check it + to decide the multibyteness of STR1 and STR2. If + target_multibyte is zero, convert unibyte chars to multibyte + before translating and checking fastmap. + (TARGET_CHAR_AND_LENGTH): New macro. + (re_match_2_internal): In emacs, set the locale variable multibyte + to 1, otherwise to 0. New local variable target_multibyte. Check + it to decide the multibyteness of STR1 and STR2. Use + TARGET_CHAR_AND_LENGTH to fetch a character from D. + <charset, charset_not>: If multibyte is nonzero, check fastmap + only for ASCII chars. Call bcmp_translate with + target_multibyte, not with multibyte. + <begline>: Declare the local variable C as `unsigned'. + (bcmp_translate): Change the last arg name to target_multibyte. + + * search.c (compile_pattern_1): Don't adjust the multibyteness of + the regexp pattern and the matching target. Set cp->buf.multibyte + to the multibyteness of the regexp pattern. Set + cp->but.target_multibyte to the multibyteness of the matching + target. + (wordify): Use FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE instead of + FETCH_STRING_CHAR_ADVANCE. + (Freplace_match): Convert unibyte chars to multibyte. + + * syntax.c (char_quoted): Use FETCH_CHAR_AS_MULTIBYTE to convert + unibyte chars to multibyte. + (back_comment): Likewise. + (scan_words): Likewise. + (skip_chars): The arg syntaxp is deleted, and the code for + handling syntaxes is moved to skip_syntaxes. Callers changed. + Fix the case that the multibyteness of STRING and the current + buffer doesn't match. + (skip_syntaxes): New function. + (SYNTAX_WITH_MULTIBYTE_CHECK): Check C by ASCII_CHAR_P, not by + SINGLE_BYTE_CHAR_P. + (Fforward_comment): Use FETCH_CHAR_AS_MULTIBYTE to convert unibyte + chars to multibyte. + (scan_lists): Likewise. + (Fbackward_prefix_chars): Likewise. + (scan_sexps_forward): Likewise. + +2002-08-23 Kenichi Handa <handa@m17n.org> + + * xfaces.c (QCfontset): New variable. + (LFACE_FONTSET): New macro. + (check_lface_attrs): Check also LFACE_FONTSET_INDEX. + (set_lface_from_font_name): Setup LFACE_FONTSET (lface). + (Finternal_set_lisp_face_attribute): Handle QCfontset. + (Finternal_get_lisp_face_attribute): Likewise. + (lface_same_font_attributes_p): Fix checking of LFACE_FONT_INDEX, + check also LFACE_FONTSET_INDEX. + (face_fontset): Check attrs[LFACE_FONTSET_INDEX], not + attrs[LFACE_FONT_INDEX]. + (syms_of_xfaces): Intern and staticpro QCfontset. + + * dispextern.h (enum lface_attribute_index): New member + LFACE_FONTSET_INDEX. + + * fns.c (base64_encode_1): Handle eight-bit chars correctly. + +2002-08-21 Kenichi Handa <handa@m17n.org> + + * coding.c (coding_set_destination): Fix coding->destination for + the case converting a region. + (encode_coding_utf_8): Encode eight-bit chars as single byte. + (encode_coding_object): Fix coding->dst_pos and + coding->dst_pos_byte for the case converting a region. + + * insdel.c (insert_from_gap): Make it work even if PT != GTP. + + * character.h (BYTE8_STRING): New macro. + + * fns.c (base64_decode_1): Insert eight-bit chars correctly. + +2002-08-20 Kenichi Handa <handa@m17n.org> + + * xdisp.c (get_next_display_element): Don't display unibyte 8-bit + characters by octal form. + + * abbrev.c (Fexpand_abbrev): Fix for the multibyte case. + + * buffer.h (_fetch_multibyte_char_len): Extern deleted. + (FETCH_MULTIBYTE_CHAR): Don't use _fetch_multibyte_char_len. + (BUF_FETCH_MULTIBYTE_CHAR): Likewise. + (FETCH_CHAR_AS_MULTIBYTE): New macro. + + * casetab.c (set_canon, set_identity, shuffle): Simplified. + + * casefiddle.c (casify_object): Simplified. Handle the case that + the case conversion change the byte length. + (casify_region): Likewise + + * character.h (MAKE_CHAR_UNIBYTE, MAKE_CHAR_MULTIBYTE): New + macros. + + * character.c (_fetch_multibyte_char_len): This variable deleted. + (syms_of_character): Setup Vprintable_chars. + + * editfns.c (Fchar_equal): Fix for the unibyte case. + (Finsert_byte): New function. + (syms_of_editfns): Defsubr it. + + * keyboard.c (read_key_sequence): Use ~CHAR_MODIFIER_MASK instead + of direct code 0x3ffff. + + * search.c (Freplace_match): Fix for the unibyte case. + +2002-08-19 Kenichi Handa <handa@m17n.org> + + * lread.c (safe_to_load_p): Fix the logic. + + * syntax.c (scan_words): Don't treat characters belonging to + different scripts as constituting a word. + + * editfns.c (Fformat): Use ASCII_CHAR_P, not SINGLE_BYTE_CHAR_P. + + * fontset.c (Fset_fontset_font): Treat `ascii' as charset, not + script. + + * emacs.c (main): In the case of --unibyte, instead of aborting on + finding non-empty buffer, make it unibyte. + +2002-08-18 Kenichi Handa <handa@m17n.org> + + * xterm.c (x_new_fontset): Call `create-fontset-from-ascii-font' + to create a fontset. + +2002-08-18 Dave Love <fx@gnu.org> + + * character.c (Funibyte_char_to_multibyte): Doc fix. + + * xfns.c [HAVE_STDLIB_H]: Fix last change. + +2002-08-15 Kenichi Handa <handa@m17n.org> + + * fontset.c (fontset_add): Make the type `int'. + (fontset_id_valid_p): Define it if FONTSET_DEBUG is defined. + + * character.c (unibyte_char_to_multibyte): Refer to + charset_unibyte, not charset_primary. + (multibyte_char_to_unibyte): Likewise. + (Funibyte_char_to_multibyte): Likewise. + + * charset.h: (charset_unibyte): Extern it instead of + charset_primary. + + * charset.c (charset_unibyte): Renamed from charset_primary. + (Funibyte_charset): Renamed from Fprimary_charset. + (Fset_unibyte_charset): Renamed from Fset_primary_charset. + (syms_of_charset): Adjusted for the above changes. + + * w32term.c (x_produce_glyphs): Use ASCII_CHAR_P, not + SINGLE_BYTE_CHAR_P. Fix the logic of handling non-ASCII char when + it->multibyte_p is zero. + + * lisp.h (nonascii_insert_offset, Vnonascii_translation_table): + Extern deleted. + +2002-08-08 Kenichi Handa <handa@m17n.org> + + * coding.c (Fdefine_coding_system_internal): Fix category setting + for a coding system of type iso-2022. + +2002-08-02 Kenichi Handa <handa@m17n.org> + + * fontset.h (FS_LOAD_FONT): Call fs_load_font with the arg CHARSET + -1. + +2002-08-01 Kenichi Handa <handa@m17n.org> + + * syntax.c (Vnext_word_boundary_function_table): New variable. + (syms_of_syntax): Declare it as a Lisp variable. + (scan_words): Call functions in Vnext_word_boundary_function_table + if any. + + * xterm.c (x_load_font): Initialize fontp->fontset to -1. + + * fontset.c (fs_load_font): If fontp->charset is not negative, + return fontp without setting its members. + +2002-07-31 Dave Love <fx@gnu.org> + + * config.in: Generated with autoheader. + + * xfns.c [HAVE_STDLIB_H]: Change logic (instead of fixing typo). + + * m/sparc.h (HAVE_ALLOCA): Delete. + + * s/irix6-5.h: Don't include strings.h. + (bcopy, bzero, bcmp): Don't undef. + + * s/irix6-0.h (bcopy, bzero, bcmp): Don't undef. + + * s/usg5-4.h (NO_SIOCTL_H): Don't define. + (TIOCSIGSEND): Don't test IRIX6. + (bcopy, bzero, bcmp): Define conditionally. + +2002-07-31 Kenichi Handa <handa@m17n.org> + + * buffer.c (Qas, Qmake, Qto): New variables. + (Fset_buffer_multibyte): New optional arg METHOD. Caller changed. + (syms_of_buffer): Intern and staticpro Qas, Qmake, and Qto. + + * callproc.c (Fcall_process): Don't call insert_1_both directly if + we are inserting a process output into a multibyte buffer. + + * character.h (CHAR_TO_BYTE8): If C is not eight-bit char, call + multibyte_char_to_unibyte. + + * character.c (Funibyte_char_to_multibyte): If C can't be decoded + by the primary charset, make it eight-bit char. + (Fmultibyte_char_to_unibyte): Call CHAR_TO_BYTE8. + + * charset.c: (charset_eight_bit, Qeight_bit_control): New + variables. + (charset_8_bit__control, charset_8_bit_graphic, + Qeight_bit_control, Qeight_bit_graphic): These variables deleted. + (define_charset_internal): New function. + (syms_of_charset): Call define_charset_internal for pre-defined + charsets. + + * charset.h (charset_8_bit): Extern it. + + * coding.c (make_conversion_work_buffer): Adjusted for the change + of Fset_buffer_multibyte. + (encode_coding_raw_text): Increment p0 in the loop. + + * lisp.h (Fset_buffer_multibyte): Prototype adjusted. + + * xdisp.c (setup_echo_area_for_printing, set_message_1): Adjusted + for the change of Fset_buffer_multibyte. + + * fns.c (Fstring_to_multibyte): New function. + (syms_of_fns): Declare Fstring_to_multibyte as Lisp subroutine. + +2002-07-30 Dave Love <fx@gnu.org> + + * xfns.c (x_put_x_image): Declare args. + + * xfaces.c (font_name_registry, choose_face_font): Delete unused + vars. + (try_font_list): Declare an arg. + + * xdisp.c (message2_nolog, set_message): Declare an arg. + + * terminfo.c (tparam): Declare an arg. Use P_ to declare tparm. + + * syntax.c (scan_sexps_forward): Declare an arg. + + * scroll.c (calculate_scrolling, calculate_direct_scrolling): + Declare an arg. + + * lisp.h (Fnew_fontset): Declare. + + * keymap.c (push_key_description): Call CHARACTERP correctly. + + * fontset.c (fontset_add): Declare args. Call make_number + correctly. + (face_for_char): Delete unused vars. + (Fset_fontset_font): Doc fix. Delete unused vars. + + * doc.c (Fsubstitute_command_keys): Delete unused vars. + + * composite.c (update_compositions): Declare arg. + + * cm.c (calccost, cmgoto): Declare args. + + * charset.c: Remove `emacs' conditional. Doc fixes. + (map_char_table_for_charset): Declare. + + * character.c (syms_of_character) <translation-table-vector>: Doc + fix. + + * ccl.c: Remove `emacs' conditional. Include hash table stuff + from trunk. + +2002-07-26 Kenichi Handa <handa@m17n.org> + + The following changes are to allow specifying multiple font + patterns for a character range (specified by script or charset). + + * Makefile.in (abbrev.o): Depend on syntax.h. + (xfaces.o): Depend on charset.h. + + * alloc.c (Fmake_string): Use ASCII_CHAR_P, not + SINGLE_BYTE_CHAR_P. + + * ccl.c (Fccl_execute_on_string): Add `const' to local variables. + + * character.h (Vchar_script_table): Extern it. + + * character.c (Vscript_alist): This variable deleted. + (Vchar_script_table, Qchar_script_table): New variable. + (syms_of_character): Declare Vchar_script_table as a lisp variable + and initialize it. + + * chartab.c (Fmake_char_table): Doc fixed. If PURPOSE doesn't + have property char-table-extra-slots, make no extra slot. + + * dispextern.h (struct face): Member `charset' deleted. + (FACE_SUITABLE_FOR_CHAR_P): Use ASCII_CHAR_P, not + SINGLE_BYTE_CHAR_P. + (FACE_FOR_CHAR): Likewise. + (choose_face_font, lookup_non_ascii_face, font_name_registry): Add + prototypes + (lookup_face, lookup_named_face, lookup_derived_face): Prototype + fixed. + (generate_ascii_font_name): Renamed from generate_ascii_font. + + * fontset.h (get_font_repertory_func): New prototype. + (make_fontset_for_ascii_face, fs_load_font): Prototypes fixed. + (FS_LOAD_FONT): Call fs_load_font with the 3rd arg charset_ascii. + + * fontset.c (Qprepend, Qappend): New variables. + (FONTSET_CHARSET_ALIST, FONTSET_FACE_ALIST): These macros deleted. + (FONTSET_NOFONT_FACE, FONTSET_REPERTORY): New macros. + (FONTSET_REF): Optimize if FONTSET is Vdefault_fontset. + (FONTSET_REF_AND_RANGE, FONTSET_ADD): New macros. + (fontset_ref_and_range, fontset_add, reorder_font_vector) + (load_font_get_repertory): New functions. + (fontset_set): This function deleted. + (fontset_face): New arg FACE. Return face ID, not face. + Completely re-written to handle new fontset structure. Caller + changed. + (free_face_fontset): Use ASET istead of AREF (X) = Y. + (face_for_char): Don't call lookup_face. + (make_fontset_for_ascii_face): New arg FACE. + (fs_load_font): New arg CHARSET_ID. Don't check + Vfont_encoding_alist here. + (find_font_encoding): New function. + (list_fontsets): Use STRINGP, not ! NILP. + (accumulate_script_ranges): New function. + (Fset_fontset_font, Fnew_fontset, Ffontset_info): Completely + re-written to handle new fontset structure. + (Ffontset_font): Return a copy of element. + (syms_of_fontset): Define symbols Qprepend and Qappend. Fix + docstring of font-encoding-alist. + + * lisp.h (CHAR_TABLE_REF): Remove unnecessary check (IDX >= 0). + (Fset_fotset_font): Fix arguments to 5. + + * msdos.c (XMenuActivate): Adjuted for the change of + lookup_derived_face. + + * xdisp.c (message_dolog, set_message_1, extend_face_to_end_of_line): + Use ASCII_CHAR_P, not SINGLE_BYTE_CHAR_P. + (highlight_trailing_whitespace): Adjusted for the change of + lookup_named_face. + + * xfaces.c: Include charset.h. + (load_face_font): Argument C deleted. Caller changed. + (generate_ascii_font_name): Renamed from generate_ascii_font. + (font_name_registry): New function. + (cache_face): Store ascii faces before non-ascii faces in buckets. + (lookup_face): Arguments C and BASE_FACE deleted. Caller changed. + Lookup only ascii faces. + (lookup_non_ascii_face): New function. + (lookup_named_face): Argument C deleted. Caller changed. + (lookup_derived_face): Argument C deleted. Caller changed. + (try_font_list): New arg PATTERN. Caller changed. If PATTERN is + a string, just call font_list with it. + (choose_face_font): Arguments FACE and C deleted. New arg + FONT_SPEC. Caller changed. + (realize_face): Arguments C and BASE_FACE deleted. Caller + (realize_x_face): Likewise. + (realize_non_ascii_face): New function. + (realize_x_face): Call load_face_font here. + (realize_tty_face): Argument C deleted. Caller changed. + (compute_char_face): If CH is not ascii, call FACE_FOR_CHAR to + get a face ID. + (dump_realized_face): Don't print charset of FACE. + + * xfns.c (x_set_font): Always call x_new_fontset and + store_frame_parameter. + (Fx_create_frame): Call x_new_fontset, not x_new_font. + (syms_of_xfns): Set get_font_repertory_func to + x_get_font_repertory. + + * xterm.h (x_get_font_repertory): Extern it. + + * xterm.c (x_produce_glyphs): Use ASCII_CHAR_P, not + SINGLE_BYTE_CHAR_P. Fix the logic of handling non-ASCII char when + it->multibyte_p is zero. + (XTread_socket): Use ASCII_CHAR_P, not SINGLE_BYTE_CHAR_P. + (x_new_fontset): If FONTSETNAME doesn't match any existing + fontsets, create a new one. + (x_get_font_repertory): New function. + +2002-07-25 Kenichi Handa <handa@m17n.org> + + * coding.c (Ffind_coding_systems_region_internal): Detect an + ASCII only string correctly. + + * lread.c (Fload): Don't load with Qload_force_doc_strings t if + version is 0. + +2002-07-24 Kenichi Handa <handa@m17n.org> + + * lread.c: Include "coding.h". + (Qget_emacs_mule_file_char, Qload_force_doc_strings, + load_each_byte, unread_char): New variables. + (readchar_backlog): This variable deleted. + (readchar): Return a character unless load_each_byte is nonzero. + Handle the case that readcharfun is Qget_emacs_mule_file_char or a + cons. If unread_char is not -1, simply return it. + (unreadchar): Handle the case that readcharfun is + Qget_emacs_mule_file_char or a cons. Set unread_char if + necessary. + (read_multibyte): This function deleted. + (readbyte_for_lambda, readbyte_from_file, readbyte_from_string) + (read_emacs_mule_char): New functions. + (Fload): Even if the file doesn't have the extention ".elc", if + safe_to_load_p returns a positive version number, assume that the + file contains bytecompiled code. If the version is less than 22, + load the file while decoding multibyte sequences by emacs-mule. + (readevalloop): Don't use readchar_backlog. + (Fread): Likewise. Pay attention to the case that STREAM is a + cons. + (Fread_from_string): Pay attention to the case that STREAM is a + cons. + (read_escape): The arg BYTEREP deleted. + (read1): Set load_each_byte to 1 temporarily while handling + #@NUMBER. Don't call read_multibyte. + (read_vector): Call Fread with a cons. If readcharfun is + Qget_emacs_mule_file_char, decode the read string by emacs-mule. + (read_list): If doc_reference is 2, make the cdr part string as + unibyte. + (syms_of_lread): Intern and staticpro Qget_emacs_mule_file_char + and Qload_force_doc_strings. + +2002-07-23 Kenichi Handa <handa@m17n.org> + + * xdisp.c (face_before_or_after_it_pos): Call + FETCH_MULTIBYTE_CHAR with byte postion, not char position. + +2002-07-22 Kenichi Handa <handa@m17n.org> + + * character.h (TRAILING_CODE_P): New macro. + (MAYBE_UNIFY_CHAR): Adjusted for the change of Funify_charset. + (string_char_with_unification): Fix prototype. + (Vscript_alist): Extern it. + + * character.c (Vscript_alist): New variable. + (string_char_with_unification): Add `const' to local variables. + (str_as_unibyte): Likewise. + (string_escape_byte8): Likewise. + (syms_of_character): Declare script-alist as a Lisp variable. + + * charset.h (Vcharset_ordered_list): Extern it. + (charset_ordered_list_tick): Extern it. + (EMACS_MULE_LEADING_CODE_PRIVATE_11) + (EMACS_MULE_LEADING_CODE_PRIVATE_12) + (EMACS_MULE_LEADING_CODE_PRIVATE_21) + (EMACS_MULE_LEADING_CODE_PRIVATE_22): New macros + (Funify_charset): Adjusted for the change of Funify_charset. + + * charset.c (charset_ordered_list_tick): New variable. + (Fdefine_charset_internal): Increment charset_ordered_list_tick. + (Funify_charset): New optional arg DEUNIFY. If it is non-nil, + deunify intead of unify a charset. + (string_xstring_p): Add `const' to local variables. + (find_charsets_in_text): Add `const' to arguemnts and local + variables. + (encode_char): Adjusted for the change of Funify_charset. Fix + detecting of invalid code. + (Fset_charset_priority): Increment charset_ordered_list_tick. + (Fmap_charset_chars): Fix handling of default value for FROM_CODE + and TO_CODE. + + * coding.c (LEADING_CODE_PRIVATE_11, LEADING_CODE_PRIVATE_12) + (LEADING_CODE_PRIVATE_21, LEADING_CODE_PRIVATE_22): Macros + deleted. Callers changed to use + EMACS_MULE_LEADING_CODE_PRIVATE_11, etc. + (decode_coding_ccl): Add `const' to local variables. + (consume_chars): Likewise. + (Ffind_coding_systems_region_internal): Likewise. + (Fcheck_coding_systems_region): Likewise. + + * print.c (print_object): Use octal form for printing the + contents of a bool vector. + +2002-07-18 Dave Love <fx@gnu.org> + + * lread.c (Fload) <!load_dangerous_libraries>: Don't leak fd. + <version == 20>: Refuse to load. + +2002-07-17 Dave Love <fx@gnu.org> + + * fns.c: Move coding.h. + (Qcodeset, Qdays, Qmonths): New. + (concat): Use CHARACTERP instead of INTERGERP. + (Flocale_codeset): Deleted. + (Flanginfo): New function. + (syms_of_fns): Changed accordingly. + + * coding.c (adjust_coding_eol_type): Fix eol_type/eol_seen mixup. + +2002-07-16 Dave Love <fx@gnu.org> + + * casetab.c (init_casetab_once, init_casetab_once): Fix + CHAR_TABLE_SET call. + + * category.c (Fmodify_category_entry): Fix CATEGORY_MEMBER call. + + * character.c (syms_of_character): Fix CHAR_TABLE_SET call. + + * charset.c (Fmap_charset_chars): Check args. Convert Lisp types. + (load_charset_map, Fdeclare_equiv_charset, Fencode_char) + (Fset_charset_priority, syms_of_charset): Convert Lisp types. + + * charset.h (CHECK_CHARSET_GET_ID): Use XINT on AREF result. + + * coding.c (ENCODE_DESIGNATION, decode_eol) + (make_conversion_work_buffer, code_conversion_restore) + (Fdefine_coding_system_internal): Convert Lisp types. + (code_conversion_restore): Use EQ, not ==. + (Fencode_coding_string): Fix code_convert_string call. + + * coding.h (code_convert_region): Fix prototype. + + * dispextern.h (redraw_frame, redraw_garbaged_frames): Removed. + + * fontset.c (fontset_ref, fontset_set, fs_load_font) + (Ffontset_info): Convert Lisp types. + + * syntax.h (SYNTAX_ENTRY_INT): Don't use make_number. + + * xterm.c (note_mouse_movement): Fix call of window_from_coordinates. + + * xdisp.c (display_mode_element): Fix call of Fset_text_properties. + + * chartab.c: Include "...h", not <...h> in some cases. + + * callproc.c (Fcall_process): Remove unused variables. + +2002-07-12 Dave Love <fx@gnu.org> + + * coding.c (Fset_coding_system_priority): Allow null arg list. + +2002-07-03 Dave Love <fx@gnu.org> + + * minibuf.c (Fminibuffer_complete_word): Remove unused var. + (Fself_insert_and_exit): Use CHARACTERP. + + * callproc.c (Fcall_process): Remove unused vars. + + * xterm.c (XTread_socket): Add extra dead keysyms. + + * xdisp.c (decode_mode_spec_coding): Use CHARACTERP. + + * dispextern.h: Remove prototypes for redraw_frame, + redraw_garbaged_frames. + + * cmds.c (Fself_insert_command): Use CHARACTERP. + + * chartab.c (make_sub_char_table): Remove unused var. + (Fset_char_table_default, Fmap_char_table): Doc fix. + + * keymap.c (access_keymap): Remove generic char code. + (push_key_description): Use CHARACTERP. + +2002-07-01 Dave Love <fx@gnu.org> + + * charset.c: Doc fixes. + (Funify_charset): Extra checking. + +2002-06-24 Dave Love <fx@gnu.org> + + * lread.c: Remove some unused variables. + (safe_to_load_p): If safe, return the magic number version byte. + (Fload): Maybe use load-with-code-conversion. + +2002-06-12 Kenichi Handa <handa@m17n.org> + + * category.c (Fmodify_category_entry): Don't modify the contents + of category_set for characters out of the range. Avoid + unnecessary modification. + + * character.h (MAYBE_UNIFY_CHAR): Adjusted for the change of + Vchar_unify_table. The default value of the table is now nil. + + * character.c (syms_of_character): Setup Vchar_width_table for + eight-bit-control and raw-byte chars. + + * charset.h (enum define_charset_arg_index): Delete + charset_arg_parents and add charset_arg_subset and + charset_arg_superset. + (enum charset_attr_index): Delete charset_parents and add + charset_subset and charset_superset. + (enum charset_method): Delete CHARSET_METHOD_INHERIT and add + CHARSET_METHOD_SUBSET and CHARSET_METHOD_SUPERSET. + (CHARSET_ATTR_PARENTS, CHARSET_PARENTS): Macros deleted. + (CHARSET_ATTR_SUBSET, CHARSET_ATTR_SUPERSET, CHARSET_SUBSET) + (CHARSET_SUPERSET): New macros. + (charset_work): Extern it. + (ENCODE_CHAR): Use charset_work. + (CHAR_CHARSET_P): Adjusted for the change of encoder format. + (map_charset_chars): Extern it. + + * charset.c (load_charset_map): Set the default value of encoder + and deunifier char-tables to nil. + (map_charset_chars): Argument changed. Callers changed. Use + map_char_table_for_charset instead of map_char_table. + (Fmap_charset_chars): New optional args from_code and to_code. + (Fdefine_charset_internal): Adjusted for the change of + `define-charset' (:parents -> :subset or :superset). + (charset_work): New variable. + (encode_char): Adjusted for the change of + Fdefine_charset_internal. + (syms_of_charset): Likewise. + (Ffind_charset_string): Setup the vector `charsets' correctly. + + * chartab.c (sub_char_table_ref_and_range): New arg defalt. Fix + the previous change. + (char_table_ref_and_range): Adjusted for the above change. + (map_sub_char_table_for_charset): New function. + (map_char_table_for_charset): New function. + + * keymap.c (describe_vector): Handle a char-table directly here. + (describe_char_table): Deleted. + + * lisp.h (map_charset_chars): Deleted. + +2002-06-11 Dave Love <fx@gnu.org> + + * fns.c (count_combining): Comment out (unused). + (Flocale_codeset): New. + (syms_of_fns): Defsubr it. + + * config.in (HAVE_PTY_H, HAVE_SIZE_T, HAVE_LANGINFO_CODESET): New. + (size_t): Removed. + +2002-06-06 Dave Love <fx@gnu.org> + + * Makefile.in (chartab.o): Depend on charset.h + +2002-06-03 Kenichi Handa <handa@m17n.org> + + * character.c (syms_of_character): Set the default value of + Vprintable_chars to Qnil. + +2002-05-31 Dave Love <fx@gnu.org> + + * Makefile.in (lisp, shortlisp): Change indian.elc to indian.el. + +2002-05-31 Kenichi Handa <handa@m17n.org> + + * charset.c (load_charset_map): Handle the case that from < to + correctly. + + * coding.c (encode_coding_emacs_mule): Pay attention to raw-8-bit + chars. + (encode_coding_iso_2022): Likewise. + (encode_coding_sjis): Likewise. + (encode_coding_big5): Likewise. + (encode_coding_charset): Likewise. + +2002-05-30 Kenichi Handa <handa@m17n.org> + + * Makefile.in (lisp): Change chinese.elc to chinese.el. They are + not bytecompiled now. + (shortlisp): Likewise. + + * charset.c (charset_jisx0201_roman, charset_jisx0208_1978) + (charset_jisx0208): New variables. + (Fdefine_charset_internal): Setup them if appropriate. + (init_charset_once): Initialize them to -1. + + * charset.h (charset_jisx0201_roman, charset_jisx0208_1978, + charset_jisx0208): Extern them. + + * coding.c (CODING_ISO_FLAG_USE_ROMAN): New macro + (CODING_ISO_FLAG_USE_OLDJIS): New macro. + (CODING_ISO_FLAG_FULL_SUPPORT): Macro definition changed. + (setup_iso_safe_charsets): Fix arguemtns to Fassq. + (DECODE_DESIGNATION): Pay attention to CODING_ISO_FLAG_USE_ROMAN + and CODING_ISO_FLAG_USE_OLDJIS. + (ENCODE_ISO_CHARACTER_DIMENSION1): Likewise. + (ENCODE_ISO_CHARACTER_DIMENSION2): Likewise. + (encode_coding_iso_2022): Change the 1st arg to + ENCODE_ISO_CHARACTER to a variable. + +2002-05-29 Kenichi Handa <handa@m17n.org> + + * charset.h (enum define_charset_arg_index): New enums + charset_arg_min_code and charset_arg_max_code. + (struct charset): New member char_index_offset. + + * charset.c (CODE_POINT_TO_INDEX): Take charset->char_index_offset + into account. + (INDEX_TO_CODE_POINT): Likewise. + (Fdefine_charset_internal): Handle args[charset_arg_min_code] and + args[charset_arg_max_code]. Setup charset.char_index_offset. + (syms_of_charset): Fix args to Fdefine_charset_internal. + +2002-05-27 Dave Love <fx@gnu.org> + + * coding.c (decode_coding_utf_8): Reject overlong sequences. + +2002-05-26 Dave Love <fx@gnu.org> + + * coding.c: Doc fixes. + (Fcoding_system_aliases): Fix return value. + (Qmac): Remove (duplicated) definition. + +2002-05-25 Dave Love <fx@gnu.org> + + * charset.c (Fcharset_priority_list, Fset_charset_priority): New + functions. + + * character.c (Fstring): Doc fix. + + * charset.c (Fdefine_charset_alias): Update Vcharset_list. + + * fontset.c (Ffontset_info): Doc fix. Return charset names, not + ids. + (font-encoding-alist): Doc fix. + +2002-05-24 Dave Love <fx@gnu.org> + + * term.c (costs_set): Declare static, non-initialized for pcc. + (encode_terminal_code): Remove ensued var. + + * keyboard.c (kbd_buffer_store_event): Fix interrupt_signal decl + for K&R. + + * xterm.c (xlwmenu_window_p): Fix prototype for K&R. + + * coding.c (setup_iso_safe_charsets): Fix arg decl for K&R. + (suffixes): Moved out of make_subsidiaries for K&R. + + * charset.c (map_charset_chars): Fix c_function declaration for + K&R. + + * lisp.h (DEFUN) [!PROTOTYPES]: Remove spurious `args'. + +2002-05-23 Dave Love <fx@gnu.org> + + * data.c (Fchar_or_string_p): Doc fix. Use CHARACTERP. + + * category.c (Fmodify_category_entry): Doc fix. Remove unused + vars. + +2002-05-23 Yong Lu <lyongu@asia-infonet.com> + + * charset.c (Fdefine_charset_internal): Fix argument to bzero. + + * coding.c (Fdefine_coding_system_internal): Fix previous change. + (decode_coding_charset): Workaround for the bug of GCC 2.96. + +2002-05-23 Kenichi Handa <handa@m17n.org> + + * Makefile.in (lisp): Change cyrillic.elc to cyrillic.el, + vietnamese.elc to vietnamese.el. They are not bytecompiled now. + (shortlisp): Likewise. + +2002-05-22 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding_charset): Adjusted for the change of + Fdefine_coding_system_internal. + (Fdefine_coding_system_internal): For a coding system of + `charset' type, store a list of charset IDs in + `charset_attr_charset_valids' element of coding attributes. + + * charset.c (Fmake_char): Fix previous change. + +2002-05-21 Kenichi Handa <handa@m17n.org> + + * coding.c (ONE_MORE_BYTE_NO_CHECK): Increment consumed_chars. + (emacs_mule_char): New arg src. Delete arg `composition'. Caller + changed. Handle 2-byte and 3-byte charsets correctly. + (DECODE_EMACS_MULE_COMPOSITION_RULE_20): Renamed from + DECODE_EMACS_MULE_COMPOSITION_RULE. Caller changed. + (DECODE_EMACS_MULE_COMPOSITION_RULE_21): New macro. + (DECODE_EMACS_MULE_21_COMPOSITION): Call + DECODE_EMACS_MULE_COMPOSITION_RULE_21. Produce correct annotation + sequence. + (decode_coding_emacs_mule): Handle composition correctly. Rewind + `src' and `consumed_chars' correctly before calling + emacs_mule_char. + (DECODE_COMPOSITION_START): Correctly handle the case of altchar + and alt&rule composition. + (decode_coding_iso_2022): Handle composition correctly. + (init_coding_once): Setup emacs_mule_bytes for private charsets. + + * charset.c (Fdefine_charset_internal): Fix bug for the case of + re-defining a charset. If the charset has :emacs-mule-id, setup + emacs_mule_bytes. + (Fmake_char): If CODE1 is nil, use the minimum code of the + charset. + +2002-05-20 Kenichi Handa <handa@m17n.org> + + * coding.c (encode_coding_iso_2022): If coding requires safe + encoding, produce a character specified by + CODING_INHIBIT_CHARACTER_SUBSTITUTION. + (encode_coding_sjis): Likewise. + (encode_coding_big5): Likewise. + (encode_coding_charset): Likewise. + +2002-05-17 Dave Love <fx@gnu.org> + + * xterm.c (XSetIMValues): Declare. + + * process.c: Conditionally include sys/wait.h, pty.h. + + * print.c (print_object): Fix print format for 64-bit + systems. + + * keyboard.c (modify_event_symbol): Fix print format for 64-bit + systems. + + * buffer.c (emacs_strerror): Declare. + (MMAP_ALLOCATED_P, mmap_enlarge, syms_of_buffer): Import changes + from trunk. + + * fontset.c (Fclear_face_cache): Declare. + (accumulate_font_info): Commented-out (unused). + (face_for_char, Fset_fontset_font, Ffontset_info): Remove unused + variables. + + * character.h (string_escape_byte8): Declare. + + * charset.c (load_charset_map, load_charset_map_from_file): Remove + unused vars. + (Fdefine_charset_internal, Fsplit_char, syms_of_charset) + (Fmap_charset_chars): Doc fix. + + * coding.c (Vchar_coding_system_table, Qchar_coding_system): + Removed. + (Fset_coding_system_priority, Fset_coding_system_priority) + (Fdefine_coding_system_internal): Doc fix. + +2002-05-16 Dave Love <fx@gnu.org> + + * s/osf5-0.h (C_SWITCH_SYSTEM) [!__GNUC__]: Remove -nointrinsics. + +2002-05-16 Kenichi Handa <handa@m17n.org> + + * character.c (string_escape_byte8): Make multibyte string with + correct size. + + * charset.c (Fmake_char): Delete unnecessary code. + +2002-05-14 Kenichi Handa <handa@m17n.org> + + * xfns.c (x_encode_text): Allocate coding.destination here, and + call encode_coding_object with dst_object Qnil. + + * buffer.c (Fset_buffer_multibyte): Convert 8-bit bytes to + multibyte form correctly. + + * fontset.c (fs_load_font): Check fontp->full_name (not fontname) + against Vfont_encoding_alist. + + * coding.c (Fdecode_sjis_char): Fix typo (0x7F->0xFF). Fix the + handling of charset list. + (encode_coding_iso_2022): Setup coding->safe_charsets in advance. + (decode_coding_object): Move point to coding->dst_pos before + calling post-read-conversion function. + (encode_coding_object): Give correct arguments to + pre-write-conversion. Ignore the return value of + pre-write-conversion function. Pay attention to the case that + pre-write-conversion changes the current buffer. If dst_object is + Qt, even if coding->src_bytes is zero, allocate at least one byte + to coding->destination. + + * coding.h (JIS_TO_SJIS): Fix typo (j1->s1, j2->s2). + + * charset.c (Fmake_char): Make it more backward compatible. + (Fmap_charset_chars): Fix docstring. + +2002-05-13 Dave Love <fx@gnu.org> + + * coding.c: Doc fixes. + (Fdefine_coding_system_alias): Use names, not symbols, in + coding-system-alist. + +2002-05-13 Kenichi Handa <handa@m17n.org> + + * fontset.c (free_realized_fontsets): Call Fclear_face_cache instead + of calling free_realized_face. + +2002-05-10 Yong Lu <lyongu@asia-infonet.com> + + * charset.c (load_charset_map): Fix previous change. + (read_hex): Don't treat SPC as a comment starter. + (decode_char): If CODE_POINT_TO_INDEX retruns -1, always return + -1. + (Fdecode_char): Fix typo. + +2002-05-10 Kenichi Handa <handa@m17n.org> + + * charset.h (struct charset): New member `code_space_mask'. + + * coding.c (coding_set_source): Delete the local variable + beg_byte. + (encode_coding_charset): Delete the local variable charset. + (Fdefine_coding_system_internal): Likewise. + (Fdefine_coding_system_internal): Setup + attrs[coding_attr_charset_valids] correctly. + + * charset.c (CODE_POINT_TO_INDEX): Utilize `code_space_mask' + member to check if CODE is valid or not. + (Fdefine_charset_internal): Initialize `code_space_mask' member. + (encode_char): Before calling CODE_POINT_TO_INDEX, check if CODE + is within the range of charset->min_code and carset->max_code. + +2002-05-09 Dave Love <fx@gnu.org> + + * syntax.h (syntax_temp) [!__GNUC__]: Declare. + + * dispextern.h (generate_ascii_font): Fix return type. + + * xfaces.c (generate_ascii_font): Fix arg declaration. + + * coding.c (coding_inherit_eol_type) + (Fset_terminal_coding_system_internal) + (Fset_safe_terminal_coding_system_internal): Fix arg declarations. + +2002-05-08 Kenichi Handa <handa@m17n.org> + + * coding.c (decode_coding_charset, encode_coding_charset): Handle + multiple charsets correctly. + +2002-05-07 Kenichi Handa <handa@m17n.org> + + * search.c (boyer_moore): Fix handling of mulitbyte character + translation. + + * xdisp.c (display_mode_element): When the variable `elt' is + changed, update `this' and `lisp_string'. + +2002-05-07 Kenichi Handa <handa@m17n.org> + + * buffer.c (Fset_buffer_multibyte): Fix 8-bit char handling. + + * callproc.c (Fcall_process): Be sure to give the current buffer + to decode_coding_c_string. Update PT and PT_BYTE after the + insertion. + + * charset.c (struct charset_map_entries): New struct. + (load_charset_map): Renamed from parse_charset_map. New args + entries and n_entries. Caller changed. + (load_charset_map_from_file): Renamed from load_charset_map. + Caller changed. New arg control_flag. Call load_charset_map at + the tail. + (load_charset_map_from_vector): New function. + (Fdefine_charset_internal): Setup charset.compact_codes_p. + (encode_char): If the charset is compact, change a character index + to a code point. + + * coding.c (coding_alloc_by_making_gap): Check the case that the + source and destination are the same correctly. + (decode_coding_raw_text): Set coding->consumed_char and + coding->consumed to 0. + (produce_chars): If coding->chars_at_source is nonzero, update + coding->consumed_char and coding->consumed before calling + alloc_destination. + (Fdefine_coding_system_alias): Register ALIAS in + Vcoding_system_alist. + (syms_of_coding): Define `no-convesion' coding system at the tail. + + * fileio.c (Finsert_file_contents): Set coding_system instead of + val. If the current buffer is multibyte, always call + decode_coding_gap. + + * xfaces.c (try_font_list): Give higher priority to fontset's + family than face's family. + +2002-04-18 Kenichi Handa <handa@m17n.org> + + * callproc.c (Fcall_process): Be sure to give the current buffer + to decode_coding_c_string. + + * xfaces.c (try_font_list): Give a family specified in a fontset + higher priority than a family specified in a face. + +2002-04-09 Kenichi Handa <handa@m17n.org> + + * fileio.c (Finsert_file_contents): Fix calculation of `inserted'. + Fix arguments to insert_from_buffer. + + * xdisp.c (display_mode_element): Fix calculation of `bytepos'. + +2002-03-11 Kenichi Handa <handa@m17n.org> + + * coding.c (produce_chars): Set the variable `multibytep' correctly. + (decode_coding_gap): Set coding->dst_multibyte correctly. + +2002-03-07 Kenichi Handa <handa@m17n.org> + + * coding.c (encode_coding_utf_8): Initialize produced_chars to 0. + (decode_coding_utf_16): Fix converting high and low bytes to + code-point. + (encode_coding_utf_16): Substitute coding->default_char for + non-Unicode characters. + (decode_coding): Don't call record_insert here. + (setup_coding_system): Initialize `surrogate' of + coding->spec.utf_16 to 0. + (EMIT_ONE_BYTE): Fix for multibyte case. + + * insdel.c (insert_from_gap): Call record_insert. + +2002-03-04 Kenichi Handa <handa@m17n.org> + + * casefiddle.c (casify_region): Fix multibyte case. + + * character.c (c_string_width): Add return type `int'. + (char_string_with_unification): Arg ADVANCED deleted. + + * character.h (CHAR_VALID_P): Don't call CHARACTERP. + (CHAR_STRING): Adjusted for the change of + char_string_with_unification. + (CHAR_STRING_ADVANCE): Make it do-while statement. + + * chartab.c (sub_char_table_set_range): Optimized for the case + DEPTH == 3. Add workaround code for a GCC optimization bug. + + * charset.c (parse_charset_map): Remove an unused variable. + + * coding.c: Delete unused variables. + + * fileio.c (Finsert_file_contents): Set coding_system to Qnil + earlier. If inserted is zero and the coding system doesn't + require flushing, don't call decode_coding_gap. + + * syntax.h (SET_RAW_SYNTAX_ENTRY): Don't call make_number. + +2002-03-01 Kenichi Handa <handa@m17n.org> + + The following changes are for using Unicode as an internal + character model, and use UTF-8 format for buffer/string + representation. + + * .gdbinit (xchartable): Adjusted for the change of char table + structure. + (xsubchartable, xcoding, xcharset, xcurbuf): New commands. + + * Makefile.in (obj): Add character.o and chartab.o. + (lisp, shortlisp): Remove utf-8.elc: + (*.o): For many files, change dependency on charset.h to + character.h, and add dependency on character.h. + (character.o, chartab.o): New targets. + + * abbrev.c, bytecode.c, casefiddle.c, cmds.c, dispnew.c, doc.c, + doprnt.c, dosfns.c, frame.c, marker.c, minibuf.c, msdos.c, + w16select.c, w32bdf.c, w32console.c: Include "character.h" instead + of "charset.h". + + * dired.c, filelock.c: Include "character.h". + + * alloc.c: Include "character.h" instead of "charset.h". + (Fmake_char_table): Moved to chartab.c. + (make_sub_char_table): Likewise. + (syms_of_alloc): Remove defsubr for Smake_char_table. + + * buffer.c: Include "character.h" instead of "charset.h", don't + include "coding.h". + (Fset_buffer_multibyte): Adjuted for UTF-8. + + * buffer.h: EXFUN Fbuffer_live_p. + + * callproc.c: Include "character.h" instead of "charset.h". + (Fcall_process): Big change for the new code-conversion APIs. + + * casetab.c: Include "character.h" instead of "charset.h". + (set_canon, set_identity, shuffle): Adjusted for the new + map_char_table spec. + (init_casetab_once): Call CHAR_TABLE_SET instead of directly + accessing the char table structure. + + * chartab.c: New file that implements char table. + + * category.c: Include "character.h". + (copy_category_entry): New function. + (copy_category_table): Call map_char_table and copy_category_entry. + (Fmake_category_table): Initialize all top-vel slots. + (char_category_set): New function. + (modify_lower_category_set): Deleted. + (Fmodify_category_entry): Call char_table_ref_and_range. + + * category.h (CATEGORY_SET): Just call char_category_set. + + * ccl.c: Include "character.h". + (Qccl, Qcclp): New variables. + (CCL_WRITE_CHAR): Alway treat the arg CH as a character even if + it's less than 256. + (CCL_WRITE_MULTIBYTE_CHAR): Deleted. + (CCL_WRITE_STRING, CCL_READ_CHAR): Adjusted for the change of SRC + and DST type. + (ccl_driver): Types of arguments changed. Code adjusted for that. + (Fccl_execute, Fccl_execute_on_string): Adjusted for the change of + ccl_driver. + (syms_of_ccl): Intern and staticpro Qccl and Qcclp. + + * ccl.h (struct ccl_program): Members eol_type and multibyte + deleted. New members src_multibyte, dst_multibyte, consumed, and + produced. + (struct ccl_spec): Members decoder and encoder deleted. New + memeber ccl. + (CODING_SPEC_CCL_PROGRAM): New macro. + (ccl_driver): Prototype updated. + (Qccl, Qcclp, Fccl_program_p): Extern them. + (CHECK_CCL_PROGRAM): New macro. + + * character.c, character.h, chartab.c: New files. + + * charset.c: Mostly re-written. Character and multibyte sequence + handling codes are moved to character.c. + + * charset.h: Mostly re-written. Character and multibyte sequence + handling codes are moved to character.h. + + * coding.c, coding.h: Mostly re-written. + + * composite.c: Include "character.h" instead of "charset.h". + (CHAR_WIDTH): Moved to character.h. + (HASH_KEY, HASH_VALUE): Deleted. + + * composite.h (enum composition_method): Order of enumeration + symbols changed. + + * data.c: Include "character.h" instead of "charset.h". + (Faref): Call CHAR_TABLE_REF for a char table. + (Faset): Call CHAR_TABLE_SET for a char table. + + * dispextern.h (free_realized_face, check_face_attribytes, + generate_ascii_font): Extern them. + (free_realized_multibyte_face): Extern deleted. + + * disptab.h (DISP_CHAR_VECTOR): Adjusted for the change of char + table structure. + + * editfns.c: Include "character.h" instead of "charset.h". + (Fchar_to_string): Always call CHAR_STRING. + + * emacs.c (main): Call init_charset_once, init_charset, + syms_of_chartab, and syms_of_character. + + * fileio.c: Include "character.h" instead of "charset.h". + (Finsert_file_contents): Big change for the new code-conversion + API. + (choose_write_coding_system): Likewise. + (Fwrite_region): Likewise. + (build_annotations_2): Deleted. + (e_write): Big change for the new code-conversion API. + + * fns.c: Include "character.h" instead of "charset.h". + (copy_sub_char_table): Moved to chartab.c. + (Fcopy_sequence): Call copy_char_table for a char table. + (concat): Delete codes calling count_multibyte. + (string_char_to_byte): Adjusted for the new multibyte form. + (string_byte_to_char): Likewise. + (internal_equal): Adjusted for the change of char table structure. + (Fchar_table_subtype, Fchar_table_parent, Fset_char_table_parent, + Fchar_table_extra_slot, Fset_char_table_extra_slot, + Fchar_table_range, Fset_char_table_range, Fset_char_table_default, + char_table_translate, optimize_sub_char_table, + Foptimize_char_table, map_char_table, Fmap_char_table): Moved to + chartab.c. + (char_table_ref_and_index): Deleted. + (HASH_KEY, HASH_VALUE): Moved to lisp.h. + (Fmd5): Call preferred_coding_system instead of accessing + Vcoding_category_list. Adjusted for the new code-conversion API. + (syms_of_fns): Defsubr for char table related functions moved to + chartab.c. + + * fontset.c: Mostly re-written. + + * fontset.h (struct font_info): Type of the member encoding_type + changed. + (enum FONT_SPEC_INDEX): New enum. + (fontset_font_pattern, fs_load_font): Prototype updated. + (FS_LOAD_FONT): Adjusted for the change of fs_load_font. + + * indent.c: Include "character.h" instead of "charset.h". + (MULTIBYTE_BYTES_WIDTH): Call CHAR_WIDTH instead of + WIDTH_BY_CHAR_HEAD. + + * insdel.c: Include "character.h" instead of "charset.h". + (copy_text): Don't refer to Vnonascii_translation_table. + (insert_from_gap): New function. + + * keyboard.c: Include "character.h" instead of "charset.h". + (command_loop_1): Never call direct_output_forward_char before + a non-ASCII character. + (read_char): If Vkeyboard_translate_table is a char table, always + translated a character. + + * keymap.c: Include "character.h". + (store_in_keymap): Handle the case that IDX is a cons. + (Fdefine_key): Handle the case that KEY is a cons and the car part + is also a cons (range). + (push_key_description): Adjusted for the new character code. + (describe_vector): Call describe_char_table for a char table. + (describe_char_table): New function. + + * keymap.h (describe_char_table): Extern it. + + * lisp.h (enum pvec_type): New member PVEC_SUB_CHAR_TABLE. + (XSUB_CHAR_TABLE, XSETSUB_CHAR_TABLE): New macros. + (CHAR_TABLE_ORDINARY_SLOTS, CHAR_TABLE_SINGLE_BYTE_SLOTS, + SUB_CHAR_TABLE_ORDINARY_SLOTS, SUB_CHAR_TABLE_STANDARD_SLOTS): + Deleted. + (CHAR_TABLE_REF, CHAR_TABLE_SET): Adjusted for the new char table + structure. + (CHAR_TABLE_TRANSLATE): Just call char_table_translate. + (CHARTAB_SIZE_BITS_0, CHARTAB_SIZE_BITS_1, CHARTAB_SIZE_BITS_2, + CHARTAB_SIZE_BITS_3): New macros. + (chartab_size): Extern it. + (struct Lisp_Char_Table): Re-designed. + (struct Lisp_Sub_Char_Table): New structure. + (HASH_KEY, HASH_VALUE): Moved from fns.c. + (CHARACTERBITS): Defined as 22. + (GLYPH_MASK_FACE, GLYPH_MASK_CHAR): Adjusted for the above change. + (SUB_CHAR_TABLE_P): Check PVEC_CHAR_TABLE. + (GC_SUB_CHAR_TABLE_P): New macro. + (Fencode_coding_string, Fdecode_coding_string): EXFUN Updated. + (code_convert_string_norecord): Extern deleted. + (init_character_once, syms_of_character, init_charset, + syms_of_composite, Qeq, Fmakehash, insert_from_gap): Extern them. + + * lread.c: Include "character.h". + (read_multibyte): New arg NBYTES. + (read_escape): The meaning of returned *BYTEREP changed. + (to_multibyte): Deleted. + (read1): Adjuted the handling of char table and string. + + * print.c: Include "character.h" instead of "charset.h". + (print_string): Convert 8-bit raw bytes to octal form by + string_escape_byte8. + (print_object): Adjusted for the new multibyte form. Print 8-bit + raw bytes always in octal form. Handle sub char table correctly. + + * process.c: Include "character.h" instead of "charset.h". + (read_process_output): Adjusted for the new code-conversion API. + (send_process): Likewise. + + * puresize.h (BASE_PURESIZE): Increased. + + * regex.c: Include "character.h" instead of "charset.h". + (BYTE8_TO_CHAR, CHAR_BYTE8_P) [not emacs]: New dummy macros. + (regex_compile): Accept a range whose starting and ending + character have different leading bytes. + (analyse_first): Adjusted for the above change. + + * search.c: Include "character.h" instead of "charset.h". + (search_buffer, boyer_moore): Adjusted for the new multibyte form. + (Freplace_match): Adjusted for the change of + multibyte_char_to_unibyte. + + * syntax.c: Include "character.h" instead of "charset.h". + (syntax_parent_lookup): Deleted. + (Fmodify_syntax_entry): Accept a cons as CHAR. + (skip_chars): Adjusted for the new multibyte form. + (init_syntax_once): Call char_table_set_range instead of directly + accessing the structure of a char table. + + * syntax.h (SET_RAW_SYNTAX_ENTRY): Call CHAR_TABLE_SET. + (SYNTAX_ENTRY_FOLLOW_PARENT): Macro deleted. + (SET_RAW_SYNTAX_ENTRY_RANGE): New macro. + (SYNTAX_ENTRY_INT): Call CHAR_TABLE_REF. + + * term.c: Include "buffer.h" and "character.h". + (encode_terminal_code): Adjusted for the new code-conversion API. + (write_glyphs): Likewise. + (produce_glyphs): Call CHAR_WIDTH instead of CHARSET_WIDTH. + + * w32term.c (x_new_font): Adjusted for the change of FS_LOAD_FONT. + + * xdisp.c: Include "character.h". + (get_next_display_element): Adjusted for the new multibyte form. + (disp_char_vector): Adjusted for the new char table structure. + (decode_mode_spec_coding): Adjusted for the new structure of + coding system. + (decode_mode_spec): Adjusted for the new code-conversion API. + + * xfaces.c: Include "character.h" instead of "charset.h". + (load_face_font): Adjusted for the change of choose_face_font and + FS_LOAD_FONT. + (generate_ascii_font): New function. + (set_lface_from_font_name): Adjusted for the change of + FS_LOAD_FONT. + (set_font_frame_param): Adjusted for the change of + choose_face_font. + (free_realized_face): Make it public. + (free_realized_faces_for_fontset): Renamed from + free_realized_multibyte_face. Free also faces realized for ASCII. + (choose_face_font): Argments changed. Adjusted for the change of + fontset_font_pattern and FS_LOAD_FONT. + + * xfns.c: Include "character.h". + (x_encode_text): Adjusted for the new code-conversion API. + + * xselect.c: Don't include "charset.h". + (selection_data_to_lisp_data): Adjusted for the new code + covnersion API. + + * xterm.c: Include "character.h". + (x_encode_char): New argument CHARSET. Caller changed. + (x_get_char_face_and_encoding): Call ENCODE_CHAR instead of + SPLIT_CHAR. + (x_get_glyph_face_and_encoding): Likewise. + (x_produce_glyphs): Don't check Vnonascii_translation_table Call + CHAR_WIDTH instead of CHARSET_WIDTH. + (XTread_socket): Adjusted for the new code-conversion API. + (x_new_font): Adjusted for the change of FS_LOAD_FONT. + (x_load_font): Adjusted for the change of struct font. + +;; Local Variables: +;; coding: iso-2022-7bit +;; End: + + Copyright (C) 2002 Free Software Foundation, Inc. + Copying and distribution of this file, with or without modification, + are permitted provided the copyright notice and this notice are preserved. + +;;; arch-tag: 1bff38bd-2030-46ae-9d18-f15e6006b665 diff --git a/src/Makefile.in b/src/Makefile.in index fd8afdc99ba..e1e5d457fc2 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -51,6 +51,7 @@ LIBOBJS = @LIBOBJS@ dot = . dotdot = ${dot}${dot} lispsource = ${srcdir}/$(dot)$(dot)/lisp/ +admindir = $(srcdir)/$(dot)$(dot)/admin/ libsrc = $(dot)$(dot)/lib-src/ etc = $(dot)$(dot)/etc/ oldXMenudir = $(dot)$(dot)/oldXMenu/ @@ -281,7 +282,7 @@ DBUS_OBJ = dbusbind.o /* C_SWITCH_X_SITE must come before C_SWITCH_X_MACHINE and C_SWITCH_X_SYSTEM since it may have -I options that should override those two. */ -ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAGS) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM C_SWITCH_SYSTEM_TEMACS ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} ${CFLAGS} +ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAGS) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM C_SWITCH_SYSTEM_TEMACS ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} ${CFLAGS} @FREETYPE_CFLAGS@ @FONTCONFIG_CFLAGS@ @LIBOTF_CFLAGS@ @M17N_FLT_CFLAGS@ .c.o: $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $< @@ -590,10 +591,29 @@ emacsapp = $(PWD)/$(mac)Emacs.app/ emacsappsrc = ${srcdir}/../mac/Emacs.app/ #endif +#ifdef HAVE_WINDOW_SYSTEM +FONTSRC = font.h +#ifdef USE_FONT_BACKEND +#ifdef HAVE_X_WINDOWS +#if defined (HAVE_XFT) +FONTOBJ = font.o xfont.o ftfont.o xftfont.o ftxfont.o +#elif defined (HAVE_FREETYPE) +FONTOBJ = font.o xfont.o ftfont.o ftxfont.o +#else /* ! defined (HAVE_XFT) && ! defined (HAVE_FREETYPE) */ +FONTOBJ = font.o xfont.o +#endif /* ! defined (HAVE_XFT) && ! defined (HAVE_FREETYPE) */ +#else /* ! HAVE_X_WINDOWS */ +FONTOBJ = font.o +#endif /* ! HAVE_X_WINDOWS */ +#else /* ! USE_FONT_BACKEND */ +FONTOBJ = font.o +#endif /* ! USE_FONT_BACKEND */ +#endif /* HAVE_WINDOW_SYSTEM */ + /* lastfile must follow all files whose initialized data areas should be dumped as pure by dump-emacs. */ obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \ - charset.o coding.o category.o ccl.o \ + charset.o coding.o category.o ccl.o character.o chartab.o \ cm.o term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \ emacs.o keyboard.o macros.o keymap.o sysdep.o \ buffer.o filelock.o insdel.o marker.o \ @@ -605,7 +625,7 @@ obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \ process.o callproc.o \ region-cache.o sound.o atimer.o \ doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ - $(MSDOS_OBJ) $(MAC_OBJ) $(CYGWIN_OBJ) + $(MSDOS_OBJ) $(MAC_OBJ) $(CYGWIN_OBJ) $(FONTOBJ) /* Object files used on some machine or other. These go in the DOC file on all machines @@ -614,7 +634,7 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \ mac.o macterm.o macfns.o macmenu.o macselect.o fontset.o \ w32.o w32bdf.o w32console.o w32fns.o w32heap.o w32inevt.o \ - w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o + w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o $(FONTOBJ) #ifdef TERMINFO @@ -736,6 +756,7 @@ lisp= \ ${lispsource}buff-menu.elc \ ${lispsource}button.elc \ ${lispsource}emacs-lisp/byte-run.elc \ + ${lispsource}composite.elc \ ${lispsource}cus-face.elc \ ${lispsource}cus-start.elc \ ${lispsource}custom.elc \ @@ -763,20 +784,11 @@ lisp= \ ${lispsource}international/mule-conf.el \ ${lispsource}international/mule-cmds.elc \ ${lispsource}international/characters.elc \ - ${lispsource}international/ucs-tables.elc \ - ${lispsource}international/utf-8.elc \ - ${lispsource}international/utf-16.elc \ - ${lispsource}international/latin-1.el \ - ${lispsource}international/latin-2.el \ - ${lispsource}international/latin-3.el \ - ${lispsource}international/latin-4.el \ - ${lispsource}international/latin-5.el \ - ${lispsource}international/latin-8.el \ - ${lispsource}international/latin-9.el \ + ${lispsource}international/charprop.el \ ${lispsource}case-table.elc \ - ${lispsource}language/chinese.elc \ - ${lispsource}language/cyrillic.elc \ - ${lispsource}language/indian.elc \ + ${lispsource}language/chinese.el \ + ${lispsource}language/cyrillic.el \ + ${lispsource}language/indian.el \ ${lispsource}language/devanagari.el \ ${lispsource}language/kannada.el \ ${lispsource}language/malayalam.el \ @@ -792,9 +804,10 @@ lisp= \ ${lispsource}language/japanese.el \ ${lispsource}language/korean.el \ ${lispsource}language/lao.el \ + ${lispsource}language/tai-viet.el \ ${lispsource}language/thai.el \ ${lispsource}language/tibetan.elc \ - ${lispsource}language/vietnamese.elc \ + ${lispsource}language/vietnamese.el \ ${lispsource}language/misc-lang.el \ ${lispsource}language/utf-8-lang.el \ ${lispsource}language/georgian.el \ @@ -835,6 +848,7 @@ shortlisp= \ ../lisp/buff-menu.elc \ ../lisp/button.elc \ ../lisp/emacs-lisp/byte-run.elc \ + ../lisp/composite.elc \ ../lisp/cus-face.elc \ ../lisp/cus-start.elc \ ../lisp/custom.elc \ @@ -860,20 +874,10 @@ shortlisp= \ ../lisp/international/mule-conf.el \ ../lisp/international/mule-cmds.elc \ ../lisp/international/characters.elc \ - ../lisp/international/ucs-tables.elc \ - ../lisp/international/utf-8.elc \ - ../lisp/international/utf-16.elc \ - ../lisp/international/latin-1.el \ - ../lisp/international/latin-2.el \ - ../lisp/international/latin-3.el \ - ../lisp/international/latin-4.el \ - ../lisp/international/latin-5.el \ - ../lisp/international/latin-8.el \ - ../lisp/international/latin-9.el \ ../lisp/case-table.elc \ - ../lisp/language/chinese.elc \ - ../lisp/language/cyrillic.elc \ - ../lisp/language/indian.elc \ + ../lisp/language/chinese.el \ + ../lisp/language/cyrillic.el \ + ../lisp/language/indian.el \ ../lisp/language/devanagari.el \ ../lisp/language/kannada.el \ ../lisp/language/malayalam.el \ @@ -889,9 +893,10 @@ shortlisp= \ ../lisp/language/japanese.el \ ../lisp/language/korean.el \ ../lisp/language/lao.el \ + ../lisp/language/tai-viet.el \ ../lisp/language/thai.el \ ../lisp/language/tibetan.elc \ - ../lisp/language/vietnamese.elc \ + ../lisp/language/vietnamese.el \ ../lisp/language/misc-lang.el \ ../lisp/language/utf-8-lang.el \ ../lisp/language/georgian.el \ @@ -946,8 +951,9 @@ SOME_MACHINE_LISP = ${dotdot}/lisp/mouse.elc \ with GCC, we might need gnulib again after them. */ LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) $(RSVG_LIBS) $(DBUS_LIBS) \ LIBGPM LIBRESOLV LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \ - LIBS_DEBUG $(GETLOADAVG_LIBS) $(GNULIB_VAR) LIB_MATH LIB_STANDARD \ - $(GNULIB_VAR) + LIBS_DEBUG $(GETLOADAVG_LIBS) \ + @FREETYPE_LIBS@ @FONTCONFIG_LIBS@ @LIBOTF_LIBS@ @M17N_FLT_LIBS@ \ + $(GNULIB_VAR) LIB_MATH LIB_STANDARD $(GNULIB_VAR) /* Enable recompilation of certain other files depending on system type. */ @@ -959,7 +965,11 @@ LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) $(RSVG_LIBS) $(DBUS_LIBS) \ #define OBJECTS_MACHINE #endif -RUN_TEMACS = ./temacs +#ifdef HAVE_SHM +RUN_TEMACS = `/bin/pwd`/temacs -nl +#else +RUN_TEMACS = `/bin/pwd`/temacs +#endif all: emacs${EXEEXT} OTHER_FILES @@ -968,11 +978,7 @@ emacs${EXEEXT}: temacs${EXEEXT} ${etc}DOC ${lisp} rm -f emacs${EXEEXT} ln temacs${EXEEXT} emacs${EXEEXT} #else -#ifdef HAVE_SHM - LC_ALL=C $(RUN_TEMACS) -nl -batch -l loadup dump -#else /* ! defined (HAVE_SHM) */ LC_ALL=C $(RUN_TEMACS) -batch -l loadup dump -#endif /* ! defined (HAVE_SHM) */ #endif /* ! defined (CANNOT_DUMP) */ -./emacs -q -batch -f list-load-path-shadows @@ -992,6 +998,16 @@ ${etc}DOC: ${libsrc}make-docfile${EXEEXT} ${obj} ${shortlisp} ${SOME_MACHINE_LIS ${libsrc}make-docfile${EXEEXT}: cd ${libsrc}; ${MAKE} ${MFLAGS} make-docfile${EXEEXT} +#ifdef HAVE_UNIDATA +UNIDATA=${admindir}unidata/UnicodeData.txt + +${lispsource}international/charprop.el: temacs${EXEEXT} ${UNIDATA} + RUNEMACS="$(RUN_TEMACS)"; \ + cd ${admindir}unidata; \ + $(MAKE) $(MFLAGS) \ + RUNEMACS="$${RUNEMACS}" DSTDIR=${lispsource}international +#endif + /* Some systems define this to cause parallel Make-ing. */ #ifndef MAKE_PARALLEL #define MAKE_PARALLEL @@ -1092,70 +1108,81 @@ stamp-oldxmenu: it is so often changed in ways that do not require any recompilation and so rarely changed in ways that do require any. */ +abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h character.h \ + syntax.h $(config_h) buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \ - dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h charset.h \ + dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h character.h \ $(config_h) callint.o: callint.c window.h commands.h buffer.h keymap.h \ keyboard.h dispextern.h $(config_h) callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \ - process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \ + process.h systty.h syssignal.h character.h coding.h ccl.h msdos.h \ composite.h w32.h blockinput.h atimer.h systime.h frame.h termhooks.h -casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \ +casefiddle.o: casefiddle.c syntax.h commands.h buffer.h character.h \ + composite.h \ charset.h keymap.h $(config_h) casetab.o: casetab.c buffer.h $(config_h) -category.o: category.c category.h buffer.h charset.h keymap.h $(config_h) -ccl.o: ccl.c ccl.h charset.h coding.h $(config_h) -charset.o: charset.c charset.h buffer.h coding.h composite.h disptab.h \ - $(config_h) -coding.o: coding.c coding.h ccl.h buffer.h charset.h intervals.h composite.h \ +category.o: category.c category.h buffer.h charset.h keymap.h \ + character.h $(config_h) +ccl.o: ccl.c ccl.h charset.h character.h coding.h $(config_h) +character.o: character.c character.h buffer.h charset.h composite.h disptab.h \ + $(config.h) +charset.o: charset.c charset.h character.h buffer.h coding.h composite.h \ + disptab.h $(config_h) +chartab.o: charset.h character.h $(config.h) +coding.o: coding.c coding.h ccl.h buffer.h character.h charset.h intervals.h composite.h \ window.h dispextern.h frame.h termhooks.h $(config_h) cm.o: cm.c frame.h cm.h termhooks.h termchar.h $(config_h) -cmds.o: cmds.c syntax.h buffer.h charset.h commands.h window.h $(config_h) \ +cmds.o: cmds.c syntax.h buffer.h character.h commands.h window.h $(config_h) \ msdos.h dispextern.h keyboard.h keymap.h pre-crt0.o: pre-crt0.c ecrt0.o: ecrt0.c $(config_h) CRT0_COMPILE ${srcdir}/ecrt0.c -dired.o: dired.c commands.h buffer.h $(config_h) charset.h coding.h regex.h \ - systime.h blockinput.h atimer.h +dired.o: dired.c commands.h buffer.h $(config_h) character.h charset.h \ + coding.h regex.h systime.h blockinput.h atimer.h dispnew.o: dispnew.c systime.h commands.h process.h frame.h \ window.h buffer.h dispextern.h termchar.h termopts.h termhooks.h cm.h \ disptab.h indent.h intervals.h \ - xterm.h blockinput.h atimer.h charset.h msdos.h composite.h keyboard.h \ + xterm.h blockinput.h atimer.h character.h msdos.h composite.h keyboard.h \ $(config_h) -doc.o: doc.c $(config_h) epaths.h buffer.h keyboard.h keymap.h charset.h -doprnt.o: doprnt.c charset.h $(config_h) +doc.o: doc.c $(config_h) epaths.h buffer.h keyboard.h keymap.h character.h +doprnt.o: doprnt.c character.h $(config_h) dosfns.o: buffer.h termchar.h termhooks.h frame.h blockinput.h window.h \ msdos.h dosfns.h dispextern.h charset.h coding.h atimer.h systime.h \ $(config_h) -editfns.o: editfns.c window.h buffer.h systime.h $(INTERVAL_SRC) charset.h \ +editfns.o: editfns.c window.h buffer.h systime.h $(INTERVAL_SRC) character.h \ coding.h dispextern.h frame.h blockinput.h atimer.h $(config_h) emacs.o: emacs.c commands.h systty.h syssignal.h blockinput.h process.h \ termhooks.h buffer.h atimer.h systime.h $(INTERVAL_SRC) $(config_h) \ window.h dispextern.h keyboard.h keymap.h -fileio.o: fileio.c window.h buffer.h systime.h $(INTERVAL_SRC) charset.h \ +fileio.o: fileio.c window.h buffer.h systime.h $(INTERVAL_SRC) character.h \ coding.h msdos.h dispextern.h blockinput.h atimer.h $(config_h) -filelock.o: filelock.c buffer.h charset.h coding.h systime.h epaths.h $(config_h) +filelock.o: filelock.c buffer.h character.h charset.h coding.h systime.h \ + epaths.h $(config_h) filemode.o: filemode.c $(config_h) frame.o: frame.c xterm.h window.h frame.h termhooks.h commands.h keyboard.h \ - blockinput.h atimer.h systime.h buffer.h charset.h fontset.h \ + blockinput.h atimer.h systime.h buffer.h character.h fontset.h \ msdos.h dosfns.h dispextern.h w32term.h macterm.h termchar.h $(config_h) fringe.o: fringe.c dispextern.h frame.h window.h buffer.h termhooks.h $(config_h) -fontset.o: dispextern.h fontset.h fontset.c ccl.h buffer.h charset.h frame.h \ - keyboard.h termhooks.h $(config_h) +font.o: font.c dispextern.h frame.h window.h ccl.h character.h charset.h \ + font.h $(config_h) +ftfont.o: dispextern.h frame.h character.h charset.h font.h $(config_h) +fontset.o: dispextern.h fontset.h fontset.c ccl.h buffer.h character.h \ + charset.h frame.h keyboard.h termhooks.h $(FONTSRC) $(config_h) getloadavg.o: getloadavg.c $(config_h) image.o: image.c frame.h window.h dispextern.h blockinput.h atimer.h \ systime.h xterm.h w32term.h w32gui.h macterm.h macgui.h $(config_h) indent.o: indent.c frame.h window.h indent.h buffer.h $(config_h) termchar.h \ - termopts.h disptab.h region-cache.h charset.h composite.h dispextern.h \ - keyboard.h -insdel.o: insdel.c window.h buffer.h $(INTERVAL_SRC) blockinput.h charset.h \ + termopts.h disptab.h region-cache.h character.h category.h composite.h \ + dispextern.h keyboard.h +insdel.o: insdel.c window.h buffer.h $(INTERVAL_SRC) blockinput.h character.h \ dispextern.h atimer.h systime.h region-cache.h $(config_h) -keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h charset.h \ +keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h character.h \ commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \ systime.h dispextern.h syntax.h $(INTERVAL_SRC) blockinput.h \ atimer.h xterm.h puresize.h msdos.h keymap.h w32term.h macterm.h $(config_h) keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \ - atimer.h systime.h puresize.h charset.h intervals.h keymap.h window.h \ + atimer.h systime.h puresize.h character.h intervals.h keymap.h window.h \ $(config_h) lastfile.o: lastfile.c $(config_h) macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h \ @@ -1164,35 +1191,37 @@ malloc.o: malloc.c $(config_h) gmalloc.o: gmalloc.c $(config_h) ralloc.o: ralloc.c $(config_h) vm-limit.o: vm-limit.c mem-limits.h $(config_h) -marker.o: marker.c buffer.h charset.h $(config_h) +marker.o: marker.c buffer.h character.h $(config_h) md5.o: md5.c md5.h $(config_h) minibuf.o: minibuf.c syntax.h dispextern.h frame.h window.h keyboard.h \ - buffer.h commands.h charset.h msdos.h $(INTERVAL_SRC) keymap.h \ + buffer.h commands.h character.h msdos.h $(INTERVAL_SRC) keymap.h \ termhooks.h $(config_h) mktime.o: mktime.c $(config_h) msdos.o: msdos.c msdos.h dosfns.h systime.h termhooks.h dispextern.h frame.h \ - termopts.h termchar.h charset.h coding.h ccl.h disptab.h window.h \ + termopts.h termchar.h character.h coding.h ccl.h disptab.h window.h \ keyboard.h intervals.h buffer.h commands.h blockinput.h atimer.h $(config_h) process.o: process.c process.h buffer.h window.h termhooks.h termopts.h \ commands.h syssignal.h systime.h systty.h syswait.h frame.h dispextern.h \ blockinput.h atimer.h charset.h coding.h ccl.h msdos.h composite.h \ keyboard.h $(config_h) -regex.o: regex.c syntax.h buffer.h $(config_h) regex.h category.h charset.h +regex.o: regex.c syntax.h buffer.h $(config_h) regex.h category.h character.h \ + charset.h region-cache.o: region-cache.c buffer.h region-cache.h $(config_h) scroll.o: scroll.c termchar.h dispextern.h frame.h msdos.h keyboard.h \ termhooks.h $(config_h) search.o: search.c regex.h commands.h buffer.h region-cache.h syntax.h \ - blockinput.h atimer.h systime.h category.h charset.h composite.h \ - $(INTERVAL_SRC) $(config_h) + blockinput.h atimer.h systime.h category.h character.h charset.h \ + composite.h $(INTERVAL_SRC) \ + $(config_h) strftime.o: strftime.c $(config_h) -syntax.o: syntax.c syntax.h buffer.h commands.h category.h charset.h \ +syntax.o: syntax.c syntax.h buffer.h commands.h category.h character.h \ composite.h keymap.h regex.h $(INTERVAL_SRC) $(config_h) sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \ process.h dispextern.h termhooks.h termchar.h termopts.h \ frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h $(config_h) term.o: term.c termchar.h termhooks.h termopts.h $(config_h) cm.h frame.h \ - disptab.h dispextern.h keyboard.h charset.h coding.h ccl.h msdos.h \ - window.h keymap.h blockinput.h atimer.h systime.h + disptab.h dispextern.h keyboard.h character.h charset.h coding.h ccl.h \ + msdos.h window.h keymap.h blockinput.h atimer.h systime.h termcap.o: termcap.c $(config_h) terminal.o: terminal.c frame.h termchar.h termhooks.h charset.h coding.h \ keyboard.h $(config_h) @@ -1211,24 +1240,32 @@ window.o: window.c indent.h commands.h frame.h window.h buffer.h termchar.h \ disptab.h keyboard.h dispextern.h msdos.h composite.h \ keymap.h blockinput.h atimer.h systime.h $(INTERVAL_SRC) \ xterm.h w32term.h macterm.h $(config_h) -xdisp.o: xdisp.c macros.h commands.h process.h indent.h buffer.h dispextern.h coding.h \ - termchar.h frame.h window.h disptab.h termhooks.h charset.h $(config_h) \ - keyboard.h $(INTERVAL_SRC) region-cache.h xterm.h w32term.h macterm.h \ - msdos.h composite.h fontset.h blockinput.h atimer.h systime.h keymap.h -xfaces.o: xfaces.c dispextern.h frame.h xterm.h buffer.h blockinput.h \ - window.h charset.h msdos.h dosfns.h composite.h atimer.h systime.h \ - keyboard.h fontset.h w32term.h macterm.h $(INTERVAL_SRC) termchar.h \ - termhooks.h $(config_h) +xdisp.o: xdisp.c macros.h commands.h process.h indent.h buffer.h dispextern.h \ + coding.h termchar.h frame.h window.h disptab.h termhooks.h character.h \ + charset.h $(config_h) keyboard.h $(INTERVAL_SRC) region-cache.h xterm.h \ + w32term.h macterm.h msdos.h composite.h fontset.h blockinput.h atimer.h \ + systime.h keymap.h $(FONTSRC) +xfaces.o: xfaces.c dispextern.h frame.h xterm.h buffer.h blockinput.h \ + window.h character.h charset.h msdos.h dosfns.h composite.h atimer.h \ + systime.h keyboard.h fontset.h w32term.h macterm.h $(INTERVAL_SRC) \ + termchar.h termhooks.h $(FONTSRC) $(config_h) xfns.o: xfns.c buffer.h frame.h window.h keyboard.h xterm.h dispextern.h \ $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h systime.h epaths.h \ - charset.h gtkutil.h termchar.h termhooks.h $(config_h) + character.h charset.h coding.h gtkutil.h $(config_h) termhooks.h \ + fontset.h termchar.h $(FONTSRC) +xfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \ + font.h $(config_h) +xftfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \ + font.h $(config_h) +ftxfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \ + font.h $(config_h) xmenu.o: xmenu.c xterm.h termhooks.h window.h dispextern.h frame.h buffer.h \ - keyboard.h $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h systime.h \ - gtkutil.h msdos.h coding.h $(config_h) + charset.h keyboard.h $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h \ + systime.h gtkutil.h msdos.h coding.h $(config_h) xterm.o: xterm.c xterm.h termhooks.h termopts.h termchar.h window.h buffer.h \ - dispextern.h frame.h disptab.h blockinput.h atimer.h systime.h syssignal.h \ - keyboard.h gnu.h charset.h ccl.h fontset.h composite.h \ - coding.h process.h gtkutil.h $(config_h) + dispextern.h frame.h disptab.h blockinput.h atimer.h systime.h syssignal.h \ + keyboard.h gnu.h character.h charset.h ccl.h fontset.h composite.h \ + coding.h process.h gtkutil.h $(FONTSRC) $(config_h) xselect.o: xselect.c process.h dispextern.h frame.h xterm.h blockinput.h \ buffer.h atimer.h systime.h termhooks.h $(config_h) xrdb.o: xrdb.c $(config_h) epaths.h @@ -1246,28 +1283,30 @@ atimer.o: atimer.c atimer.h systime.h $(config_h) /* The files of Lisp proper */ alloc.o: alloc.c process.h frame.h window.h buffer.h puresize.h syssignal.h keyboard.h \ - blockinput.h atimer.h systime.h charset.h dispextern.h $(config_h) $(INTERVAL_SRC) -bytecode.o: bytecode.c buffer.h syntax.h charset.h window.h dispextern.h \ + blockinput.h atimer.h systime.h character.h dispextern.h $(config_h) \ + $(INTERVAL_SRC) +bytecode.o: bytecode.c buffer.h syntax.h character.h window.h dispextern.h \ frame.h xterm.h $(config_h) -data.o: data.c buffer.h puresize.h charset.h syssignal.h keyboard.h frame.h termhooks.h $(config_h) +data.o: data.c buffer.h puresize.h character.h syssignal.h keyboard.h frame.h \ + termhooks.h $(config_h) eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h \ dispextern.h $(config_h) floatfns.o: floatfns.c $(config_h) -fns.o: fns.c commands.h $(config_h) frame.h buffer.h charset.h keyboard.h \ +fns.o: fns.c commands.h $(config_h) frame.h buffer.h character.h keyboard.h \ keymap.h frame.h window.h dispextern.h $(INTERVAL_SRC) coding.h md5.h \ blockinput.h atimer.h systime.h xterm.h termhooks.h -print.o: print.c process.h frame.h window.h buffer.h keyboard.h charset.h \ +print.o: print.c process.h frame.h window.h buffer.h keyboard.h character.h \ $(config_h) dispextern.h termchar.h $(INTERVAL_SRC) msdos.h composite.h \ blockinput.h atimer.h systime.h -lread.o: lread.c commands.h keyboard.h buffer.h epaths.h charset.h \ - $(config_h) $(INTERVAL_SRC) termhooks.h coding.h msdos.h +lread.o: lread.c commands.h keyboard.h buffer.h epaths.h character.h \ + charset.h $(config_h) $(INTERVAL_SRC) termhooks.h coding.h msdos.h /* Text properties support */ textprop.o: textprop.c buffer.h window.h dispextern.h $(INTERVAL_SRC) \ $(config_h) intervals.o: intervals.c buffer.h $(INTERVAL_SRC) keyboard.h puresize.h \ keymap.h $(config_h) -composite.o: composite.c buffer.h charset.h $(INTERVAL_SRC) $(config_h) +composite.o: composite.c buffer.h character.h $(INTERVAL_SRC) $(config_h) /* System-specific programs to be made. OTHER_FILES and OBJECTS_MACHINE @@ -1370,14 +1409,10 @@ bootstrap: bootstrap-emacs${EXEEXT} /* Dump an Emacs executable named bootstrap-emacs containing the files from loadup.el in source form. */ -bootstrap-emacs${EXEEXT}: temacs${EXEEXT} +bootstrap-emacs${EXEEXT}: temacs${EXEEXT} ${lispsource}international/charprop.el #ifdef CANNOT_DUMP ln temacs${EXEEXT} bootstrap-emacs${EXEEXT} #else -#ifdef HAVE_SHM - $(RUN_TEMACS) -nl -batch -l loadup bootstrap -#else /* ! defined (HAVE_SHM) */ $(RUN_TEMACS) --batch --load loadup bootstrap -#endif /* ! defined (HAVE_SHM) */ mv -f emacs${EXEEXT} bootstrap-emacs${EXEEXT} #endif /* ! defined (CANNOT_DUMP) */ diff --git a/src/alloc.c b/src/alloc.c index 2d87e1806f0..88f37ee363c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -53,7 +53,7 @@ Boston, MA 02110-1301, USA. */ #include "keyboard.h" #include "frame.h" #include "blockinput.h" -#include "charset.h" +#include "character.h" #include "syssignal.h" #include "termhooks.h" /* For struct terminal. */ #include <setjmp.h> @@ -502,7 +502,7 @@ struct gcpro *gcprolist; /* Addresses of staticpro'd variables. Initialize it to a nonzero value; otherwise some compilers put it into BSS. */ -#define NSTATICS 1280 +#define NSTATICS 0x600 static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; /* Index of next unused slot in staticvec. */ @@ -2288,7 +2288,7 @@ INIT must be an integer that represents a character. */) CHECK_NUMBER (init); c = XINT (init); - if (SINGLE_BYTE_CHAR_P (c)) + if (ASCII_CHAR_P (c)) { nbytes = XINT (length); val = make_uninit_string (nbytes); @@ -3052,51 +3052,6 @@ See also the function `vector'. */) } -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. -PURPOSE should be a symbol which has a `char-table-extra-slots' property. -The property's value should be an integer between 0 and 10. */) - (purpose, init) - register Lisp_Object purpose, init; -{ - Lisp_Object vector; - Lisp_Object n; - CHECK_SYMBOL (purpose); - n = Fget (purpose, Qchar_table_extra_slots); - CHECK_NUMBER (n); - if (XINT (n) < 0 || XINT (n) > 10) - args_out_of_range (n, Qnil); - /* Add 2 to the size for the defalt and parent slots. */ - vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)), - init); - XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE); - XCHAR_TABLE (vector)->top = Qt; - XCHAR_TABLE (vector)->parent = Qnil; - XCHAR_TABLE (vector)->purpose = purpose; - XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); - return vector; -} - - -/* Return a newly created sub char table with slots initialized by INIT. - Since a sub char table does not appear as a top level Emacs Lisp - object, we don't need a Lisp interface to make it. */ - -Lisp_Object -make_sub_char_table (init) - Lisp_Object init; -{ - Lisp_Object vector - = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init); - XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE); - XCHAR_TABLE (vector)->top = Qnil; - XCHAR_TABLE (vector)->defalt = Qnil; - XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); - return vector; -} - - DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. @@ -4161,7 +4116,7 @@ mark_maybe_object (obj) { int mark_p = 0; - switch (XGCTYPE (obj)) + switch (XTYPE (obj)) { case Lisp_String: mark_p = (live_string_p (m, po) @@ -4181,13 +4136,13 @@ mark_maybe_object (obj) break; case Lisp_Vectorlike: - /* Note: can't check GC_BUFFERP before we know it's a + /* Note: can't check BUFFERP before we know it's a buffer because checking that dereferences the pointer PO which might point anywhere. */ if (live_vector_p (m, po)) - mark_p = !GC_SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj)); + mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj)); else if (live_buffer_p (m, po)) - mark_p = GC_BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj)); + mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj)); break; case Lisp_Misc: @@ -4278,7 +4233,7 @@ mark_maybe_pointer (p) { Lisp_Object tem; XSETVECTOR (tem, p); - if (!GC_SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem))) + if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem))) obj = tem; } break; @@ -4287,7 +4242,7 @@ mark_maybe_pointer (p) abort (); } - if (!GC_NILP (obj)) + if (!NILP (obj)) mark_object (obj); } } @@ -5051,7 +5006,8 @@ returns nil, because real GC can't be done. */) truncate_undo_list (nextb); /* Shrink buffer gaps, but skip indirect and dead buffers. */ - if (nextb->base_buffer == 0 && !NILP (nextb->name)) + if (nextb->base_buffer == 0 && !NILP (nextb->name) + && ! nextb->text->inhibit_shrinking) { /* If a buffer's gap size is more than 10% of the buffer size, or larger than 2000 bytes, then shrink it @@ -5190,8 +5146,8 @@ returns nil, because real GC can't be done. */) prev = Qnil; while (CONSP (tail)) { - if (GC_CONSP (XCAR (tail)) - && GC_MARKERP (XCAR (XCAR (tail))) + if (CONSP (XCAR (tail)) + && MARKERP (XCAR (XCAR (tail))) && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) { if (NILP (prev)) @@ -5340,7 +5296,7 @@ mark_glyph_matrix (matrix) struct glyph *end_glyph = glyph + row->used[area]; for (; glyph < end_glyph; ++glyph) - if (GC_STRINGP (glyph->object) + if (STRINGP (glyph->object) && !STRING_MARKED_P (XSTRING (glyph->object))) mark_object (glyph->object); } @@ -5496,7 +5452,7 @@ mark_object (arg) #endif /* not GC_CHECK_MARKED_OBJECTS */ - switch (SWITCH_ENUM_CAST (XGCTYPE (obj))) + switch (SWITCH_ENUM_CAST (XTYPE (obj))) { case Lisp_String: { @@ -5515,13 +5471,13 @@ mark_object (arg) case Lisp_Vectorlike: #ifdef GC_CHECK_MARKED_OBJECTS m = mem_find (po); - if (m == MEM_NIL && !GC_SUBRP (obj) + if (m == MEM_NIL && !SUBRP (obj) && po != &buffer_defaults && po != &buffer_local_symbols) abort (); #endif /* GC_CHECK_MARKED_OBJECTS */ - if (GC_BUFFERP (obj)) + if (BUFFERP (obj)) { if (!VECTOR_MARKED_P (XBUFFER (obj))) { @@ -5538,9 +5494,9 @@ mark_object (arg) mark_buffer (obj); } } - else if (GC_SUBRP (obj)) + else if (SUBRP (obj)) break; - else if (GC_COMPILEDP (obj)) + else if (COMPILEDP (obj)) /* We could treat this just like a vector, but it is better to save the COMPILED_CONSTANTS element for last and avoid recursion there. */ @@ -5563,7 +5519,7 @@ mark_object (arg) obj = ptr->contents[COMPILED_CONSTANTS]; goto loop; } - else if (GC_FRAMEP (obj)) + else if (FRAMEP (obj)) { register struct frame *ptr = XFRAME (obj); if (mark_vectorlike (XVECTOR (obj))) @@ -5574,7 +5530,7 @@ mark_object (arg) #endif /* HAVE_WINDOW_SYSTEM */ } } - else if (GC_WINDOWP (obj)) + else if (WINDOWP (obj)) { register struct Lisp_Vector *ptr = XVECTOR (obj); struct window *w = XWINDOW (obj); @@ -5592,13 +5548,13 @@ mark_object (arg) } } } - else if (GC_HASH_TABLE_P (obj)) + else if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); if (mark_vectorlike ((struct Lisp_Vector *)h)) { /* If hash table is not weak, mark all keys and values. For weak tables, mark only the vector. */ - if (GC_NILP (h->weak)) + if (NILP (h->weak)) mark_object (h->key_and_value); else VECTOR_MARK (XVECTOR (h->key_and_value)); @@ -5820,7 +5776,7 @@ survives_gc_p (obj) { int survives_p; - switch (XGCTYPE (obj)) + switch (XTYPE (obj)) { case Lisp_Int: survives_p = 1; @@ -5839,7 +5795,7 @@ survives_gc_p (obj) break; case Lisp_Vectorlike: - survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj)); + survives_p = SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj)); break; case Lisp_Cons: @@ -6449,7 +6405,6 @@ The time is in seconds as a floating point value. */); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); - defsubr (&Smake_char_table); defsubr (&Smake_string); defsubr (&Smake_bool_vector); defsubr (&Smake_symbol); diff --git a/src/buffer.c b/src/buffer.c index 58e2bd9e4cd..009d7de86fc 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -42,7 +42,7 @@ extern int errno; #include "window.h" #include "commands.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "region-cache.h" #include "indent.h" #include "blockinput.h" @@ -175,6 +175,7 @@ static struct Lisp_Overlay * copy_overlays P_ ((struct buffer *, struct Lisp_Ove static void modify_overlay P_ ((struct buffer *, EMACS_INT, EMACS_INT)); static Lisp_Object buffer_lisp_local_variables P_ ((struct buffer *)); +extern char * emacs_strerror P_ ((int)); /* For debugging; temporary. See set_buffer_internal. */ /* Lisp_Object Qlisp_mode, Vcheck_symbol; */ @@ -2181,8 +2182,10 @@ DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte, doc: /* Set the multibyte flag of the current buffer to FLAG. If FLAG is t, this makes the buffer a multibyte buffer. If FLAG is nil, this makes the buffer a single-byte buffer. -The buffer contents remain unchanged as a sequence of bytes -but the contents viewed as characters do change. +In these cases, the buffer contents remain unchanged as a sequence of +bytes but the contents viewed as characters do change. +If FLAG is `to', this makes the buffer a multibyte buffer by changing +all eight-bit bytes to eight-bit characters. If the multibyte flag was really changed, undo information of the current buffer is cleared. */) (flag) @@ -2256,11 +2259,11 @@ current buffer is cleared. */) p = GAP_END_ADDR; stop = Z; } - if (MULTIBYTE_STR_AS_UNIBYTE_P (p, bytes)) - p += bytes, pos += bytes; - else + if (ASCII_BYTE_P (*p)) + p++, pos++; + else if (CHAR_BYTE8_HEAD_P (*p)) { - c = STRING_CHAR (p, stop - pos); + c = STRING_CHAR_AND_LENGTH (p, stop - pos, bytes); /* Delete all bytes for this 8-bit character but the last one, and change the last one to the charcter code. */ @@ -2275,6 +2278,11 @@ current buffer is cleared. */) zv -= bytes; stop = Z; } + else + { + bytes = BYTES_BY_CHAR_HEAD (*p); + p += bytes, pos += bytes; + } } if (narrowed) Fnarrow_to_region (make_number (begv), make_number (zv)); @@ -2283,13 +2291,14 @@ current buffer is cleared. */) { int pt = PT; int pos, stop; - unsigned char *p; + unsigned char *p, *pend; /* Be sure not to have a multibyte sequence striding over the GAP. - Ex: We change this: "...abc\201 _GAP_ \241def..." - to: "...abc _GAP_ \201\241def..." */ + Ex: We change this: "...abc\302 _GAP_ \241def..." + to: "...abc _GAP_ \302\241def..." */ - if (GPT_BYTE > 1 && GPT_BYTE < Z_BYTE + if (EQ (flag, Qt) + && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE && ! CHAR_HEAD_P (*(GAP_END_ADDR))) { unsigned char *p = GPT_ADDR - 1; @@ -2308,6 +2317,7 @@ current buffer is cleared. */) pos = BEG; stop = GPT; p = BEG_ADDR; + pend = GPT_ADDR; while (1) { int bytes; @@ -2317,16 +2327,21 @@ current buffer is cleared. */) if (pos == Z) break; p = GAP_END_ADDR; + pend = Z_ADDR; stop = Z; } - if (UNIBYTE_STR_AS_MULTIBYTE_P (p, stop - pos, bytes)) + if (ASCII_BYTE_P (*p)) + p++, pos++; + else if (EQ (flag, Qt) && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0) p += bytes, pos += bytes; else { unsigned char tmp[MAX_MULTIBYTE_LENGTH]; + int c; - bytes = CHAR_STRING (*p, tmp); + c = BYTE8_TO_CHAR (*p); + bytes = CHAR_STRING (c, tmp); *p = tmp[0]; TEMP_SET_PT_BOTH (pos + 1, pos + 1); bytes--; @@ -2340,6 +2355,7 @@ current buffer is cleared. */) zv += bytes; if (pos <= pt) pt += bytes; + pend = Z_ADDR; stop = Z; } } @@ -2847,7 +2863,7 @@ overlay_touches_p (pos) int endpos; XSETMISC (overlay ,tail); - if (!GC_OVERLAYP (overlay)) + if (!OVERLAYP (overlay)) abort (); endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); @@ -2862,7 +2878,7 @@ overlay_touches_p (pos) int startpos; XSETMISC (overlay, tail); - if (!GC_OVERLAYP (overlay)) + if (!OVERLAYP (overlay)) abort (); startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); diff --git a/src/buffer.h b/src/buffer.h index a308d20e491..22cb21cb3ae 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -325,7 +325,6 @@ else /* Variables used locally in FETCH_MULTIBYTE_CHAR. */ extern unsigned char *_fetch_multibyte_char_p; -extern int _fetch_multibyte_char_len; /* Return character code of multi-byte form at position POS. If POS doesn't point the head of valid multi-byte form, only the byte at @@ -333,10 +332,18 @@ extern int _fetch_multibyte_char_len; #define FETCH_MULTIBYTE_CHAR(pos) \ (_fetch_multibyte_char_p = (((pos) >= GPT_BYTE ? GAP_SIZE : 0) \ - + (pos) + BEG_ADDR - BEG_BYTE), \ - _fetch_multibyte_char_len \ - = ((pos) >= GPT_BYTE ? ZV_BYTE : GPT_BYTE) - (pos), \ - STRING_CHAR (_fetch_multibyte_char_p, _fetch_multibyte_char_len)) + + (pos) + BEG_ADDR - BEG_BYTE), \ + STRING_CHAR (_fetch_multibyte_char_p, 0)) + +/* Return character at position POS. If the current buffer is unibyte + and the character is not ASCII, make the returning character + multibyte. */ + +#define FETCH_CHAR_AS_MULTIBYTE(pos) \ + (!NILP (current_buffer->enable_multibyte_characters) \ + ? FETCH_MULTIBYTE_CHAR ((pos)) \ + : unibyte_char_to_multibyte (FETCH_BYTE ((pos)))) + /* Macros for accessing a character or byte, or converting between byte positions and addresses, @@ -385,10 +392,7 @@ extern int _fetch_multibyte_char_len; (_fetch_multibyte_char_p \ = (((pos) >= BUF_GPT_BYTE (buf) ? BUF_GAP_SIZE (buf) : 0) \ + (pos) + BUF_BEG_ADDR (buf) - BEG_BYTE), \ - _fetch_multibyte_char_len \ - = (((pos) >= BUF_GPT_BYTE (buf) ? BUF_ZV_BYTE (buf) : BUF_GPT_BYTE (buf)) \ - - (pos)), \ - STRING_CHAR (_fetch_multibyte_char_p, _fetch_multibyte_char_len)) + STRING_CHAR (_fetch_multibyte_char_p, 0)) /* Define the actual buffer data structures. */ @@ -444,6 +448,11 @@ struct buffer_text successive elements in its marker `chain' are the other markers referring to this buffer. */ struct Lisp_Marker *markers; + + /* Usually 0. Temporarily set to 1 in decode_coding_gap to + prevent Fgarbage_collect from shrinking the gap and loosing + not-yet-decoded bytes. */ + int inhibit_shrinking; }; /* This is the structure that the buffer Lisp object points to. */ @@ -854,6 +863,7 @@ extern void mmap_set_vars P_ ((int)); } \ } while (0) +EXFUN (Fbuffer_live_p, 1); EXFUN (Fbuffer_name, 1); EXFUN (Fget_file_buffer, 1); EXFUN (Fnext_overlay_change, 1); @@ -897,7 +907,7 @@ extern Lisp_Object Vtransient_mark_mode; We assume you know which buffer it's pointing into. */ #define OVERLAY_POSITION(P) \ - (GC_MARKERP (P) ? marker_position (P) : (abort (), 0)) + (MARKERP (P) ? marker_position (P) : (abort (), 0)) /*********************************************************************** diff --git a/src/bytecode.c b/src/bytecode.c index 3582e69dfb7..1dd1f3671e4 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -37,7 +37,7 @@ by Hallvard: #include <config.h> #include "lisp.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "syntax.h" #include "window.h" @@ -1394,10 +1394,17 @@ If the third argument is incorrect, Emacs may crash. */) break; case Bchar_syntax: - BEFORE_POTENTIAL_GC (); - CHECK_NUMBER (TOP); - AFTER_POTENTIAL_GC (); - XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (XINT (TOP))]); + { + int c; + + BEFORE_POTENTIAL_GC (); + CHECK_CHARACTER (TOP); + AFTER_POTENTIAL_GC (); + c = XFASTINT (TOP); + if (NILP (current_buffer->enable_multibyte_characters)) + MAKE_CHAR_MULTIBYTE (c); + XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]); + } break; case Bbuffer_substring: diff --git a/src/callproc.c b/src/callproc.c index 3e6833aed44..567fe3a284d 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -75,7 +75,7 @@ extern int errno; #include "lisp.h" #include "commands.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "ccl.h" #include "coding.h" #include "composite.h" @@ -278,6 +278,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) if (nargs >= 5) { int must_encode = 0; + Lisp_Object coding_attrs; for (i = 4; i < nargs; i++) CHECK_STRING (args[i]); @@ -303,11 +304,15 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) else val = Qnil; } + val = coding_inherit_eol_type (val, Qnil); setup_coding_system (Fcheck_coding_system (val), &argument_coding); - if (argument_coding.common_flags & CODING_ASCII_INCOMPATIBLE_MASK) - setup_coding_system (Qraw_text, &argument_coding); - if (argument_coding.eol_type == CODING_EOL_UNDECIDED) - argument_coding.eol_type = system_eol_type; + coding_attrs = CODING_ID_ATTRS (argument_coding.id); + if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs))) + { + /* We should not use an ASCII incompatible coding system. */ + val = raw_text_coding_system (val); + setup_coding_system (val, &argument_coding); + } } } @@ -430,12 +435,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) { argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]); if (CODING_REQUIRE_ENCODING (&argument_coding)) - { - /* We must encode this argument. */ - args[i] = encode_coding_string (args[i], &argument_coding, 1); - if (argument_coding.type == coding_type_ccl) - setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil); - } + /* We must encode this argument. */ + args[i] = encode_coding_string (&argument_coding, args[i], 1); new_argv[i - 3] = SDATA (args[i]); } UNGCPRO; @@ -747,19 +748,15 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) else val = Qnil; } - setup_coding_system (Fcheck_coding_system (val), &process_coding); + Fcheck_coding_system (val); /* In unibyte mode, character code conversion should not take place but EOL conversion should. So, setup raw-text or one of the subsidiary according to the information just setup. */ if (NILP (current_buffer->enable_multibyte_characters) && !NILP (val)) - setup_raw_text_coding_system (&process_coding); + val = raw_text_coding_system (val); + setup_coding_system (val, &process_coding); } - process_coding.src_multibyte = 0; - process_coding.dst_multibyte - = (BUFFERP (buffer) - ? ! NILP (XBUFFER (buffer)->enable_multibyte_characters) - : ! NILP (current_buffer->enable_multibyte_characters)); immediate_quit = 1; QUIT; @@ -771,12 +768,8 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) int carryover = 0; int display_on_the_fly = display_p; struct coding_system saved_coding; - int pt_orig = PT, pt_byte_orig = PT_BYTE; - int inserted; saved_coding = process_coding; - if (process_coding.composing != COMPOSITION_DISABLED) - coding_allocate_composition_data (&process_coding, PT); while (1) { /* Repeatedly read until we've filled as much as possible @@ -809,133 +802,49 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) if (!NILP (buffer)) { - if (! CODING_MAY_REQUIRE_DECODING (&process_coding)) + if (NILP (current_buffer->enable_multibyte_characters) + && ! CODING_MAY_REQUIRE_DECODING (&process_coding)) insert_1_both (buf, nread, nread, 0, 1, 0); else { /* We have to decode the input. */ - int size; - char *decoding_buf; - - repeat_decoding: - size = decoding_buffer_size (&process_coding, nread); - decoding_buf = (char *) xmalloc (size); - - /* We can't use the macro CODING_REQUIRE_DETECTION - because it always returns nonzero if the coding - system requires EOL detection. Here, we have to - check only whether or not the coding system - requires text-encoding detection. */ - if (process_coding.type == coding_type_undecided) - { - detect_coding (&process_coding, buf, nread); - if (process_coding.composing != COMPOSITION_DISABLED) - /* We have not yet allocated the composition - data because the coding type was undecided. */ - coding_allocate_composition_data (&process_coding, PT); - } - if (process_coding.cmp_data) - process_coding.cmp_data->char_offset = PT; - - decode_coding (&process_coding, buf, decoding_buf, - nread, size); + Lisp_Object curbuf; + XSETBUFFER (curbuf, current_buffer); + decode_coding_c_string (&process_coding, buf, nread, + curbuf); if (display_on_the_fly - && saved_coding.type == coding_type_undecided - && process_coding.type != coding_type_undecided) + && CODING_REQUIRE_DETECTION (&saved_coding) + && ! CODING_REQUIRE_DETECTION (&process_coding)) { /* We have detected some coding system. But, there's a possibility that the detection was - done by insufficient data. So, we try the code - detection again with more data. */ - xfree (decoding_buf); + done by insufficient data. So, we give up + displaying on the fly. */ + if (process_coding.produced > 0) + del_range_2 (process_coding.dst_pos, + process_coding.dst_pos_byte, + process_coding.dst_pos + + process_coding.produced_char, + process_coding.dst_pos_byte + + process_coding.produced, 0); display_on_the_fly = 0; process_coding = saved_coding; carryover = nread; /* This is to make the above condition always fails in the future. */ - saved_coding.type = coding_type_no_conversion; + saved_coding.common_flags + &= ~CODING_REQUIRE_DETECTION_MASK; continue; } - if (process_coding.produced > 0) - insert_1_both (decoding_buf, process_coding.produced_char, - process_coding.produced, 0, 1, 0); - xfree (decoding_buf); - - if (process_coding.result == CODING_FINISH_INCONSISTENT_EOL) - { - Lisp_Object eol_type, coding; - - if (process_coding.eol_type == CODING_EOL_CR) - { - /* CRs have been replaced with LFs. Undo - that in the text inserted above. */ - unsigned char *p; - - move_gap_both (PT, PT_BYTE); - - p = BYTE_POS_ADDR (pt_byte_orig); - for (; p < GPT_ADDR; ++p) - if (*p == '\n') - *p = '\r'; - } - else if (process_coding.eol_type == CODING_EOL_CRLF) - { - /* CR LFs have been replaced with LFs. Undo - that by inserting CRs in front of LFs in - the text inserted above. */ - EMACS_INT bytepos, old_pt, old_pt_byte, nCR; - - old_pt = PT; - old_pt_byte = PT_BYTE; - nCR = 0; - - for (bytepos = PT_BYTE - 1; - bytepos >= pt_byte_orig; - --bytepos) - if (FETCH_BYTE (bytepos) == '\n') - { - EMACS_INT charpos = BYTE_TO_CHAR (bytepos); - TEMP_SET_PT_BOTH (charpos, bytepos); - insert_1_both ("\r", 1, 1, 0, 1, 0); - ++nCR; - } - - TEMP_SET_PT_BOTH (old_pt + nCR, old_pt_byte + nCR); - } - - /* Set the coding system symbol to that for - Unix-like EOL. */ - eol_type = Fget (saved_coding.symbol, Qeol_type); - if (VECTORP (eol_type) - && ASIZE (eol_type) == 3 - && SYMBOLP (AREF (eol_type, CODING_EOL_LF))) - coding = AREF (eol_type, CODING_EOL_LF); - else - coding = saved_coding.symbol; - - process_coding.symbol = coding; - process_coding.eol_type = CODING_EOL_LF; - process_coding.mode - &= ~CODING_MODE_INHIBIT_INCONSISTENT_EOL; - } - - nread -= process_coding.consumed; - carryover = nread; + TEMP_SET_PT_BOTH (PT + process_coding.produced_char, + PT_BYTE + process_coding.produced); + carryover = process_coding.carryover_bytes; if (carryover > 0) /* As CARRYOVER should not be that large, we had better avoid overhead of bcopy. */ - BCOPY_SHORT (buf + process_coding.consumed, buf, - carryover); - if (process_coding.result == CODING_FINISH_INSUFFICIENT_CMP) - { - /* The decoding ended because of insufficient data - area to record information about composition. - We must try decoding with additional data area - before reading more output for the process. */ - coding_allocate_composition_data (&process_coding, PT); - goto repeat_decoding; - } + BCOPY_SHORT (process_coding.carryover, buf, + process_coding.carryover_bytes); } } @@ -966,33 +875,12 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) } give_up: ; - if (!NILP (buffer) - && process_coding.cmp_data) - { - coding_restore_composition (&process_coding, Fcurrent_buffer ()); - coding_free_composition_data (&process_coding); - } - - { - int post_read_count = SPECPDL_INDEX (); - - record_unwind_protect (save_excursion_restore, save_excursion_save ()); - inserted = PT - pt_orig; - TEMP_SET_PT_BOTH (pt_orig, pt_byte_orig); - if (SYMBOLP (process_coding.post_read_conversion) - && !NILP (Ffboundp (process_coding.post_read_conversion))) - call1 (process_coding.post_read_conversion, make_number (inserted)); - - Vlast_coding_system_used = process_coding.symbol; - - /* If the caller required, let the buffer inherit the - coding-system used to decode the process output. */ - if (inherit_process_coding_system) - call1 (intern ("after-insert-file-set-buffer-file-coding-system"), - make_number (total_read)); - - unbind_to (post_read_count, Qnil); - } + Vlast_coding_system_used = CODING_ID_NAME (process_coding.id); + /* If the caller required, let the buffer inherit the + coding-system used to decode the process output. */ + if (inherit_process_coding_system) + call1 (intern ("after-insert-file-set-buffer-file-coding-system"), + make_number (total_read)); } /* Wait for it to terminate, unless it already has. */ diff --git a/src/casefiddle.c b/src/casefiddle.c index 0e9e1ba2c34..2984201a03b 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -23,7 +23,7 @@ Boston, MA 02110-1301, USA. */ #include <config.h> #include "lisp.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "commands.h" #include "syntax.h" #include "composite.h" @@ -38,7 +38,7 @@ casify_object (flag, obj) enum case_action flag; Lisp_Object obj; { - register int i, c, len; + register int c, c1; register int inword = flag == CASE_DOWN; /* If the case table is flagged as modified, rescan it. */ @@ -50,6 +50,7 @@ casify_object (flag, obj) int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META); int flags = XINT (obj) & flagbits; + int multibyte = ! NILP (current_buffer->enable_multibyte_characters); /* If the character has higher bits set above the flags, return it unchanged. @@ -57,12 +58,18 @@ casify_object (flag, obj) if ((unsigned) XFASTINT (obj) > (unsigned) flagbits) return obj; - c = DOWNCASE (XFASTINT (obj) & ~flagbits); + c1 = XFASTINT (obj) & ~flagbits; + if (! multibyte) + MAKE_CHAR_MULTIBYTE (c1); + c = DOWNCASE (c1); if (inword) XSETFASTINT (obj, c | flags); else if (c == (XFASTINT (obj) & ~flagbits)) { - c = UPCASE1 ((XFASTINT (obj) & ~flagbits)); + if (! inword) + c = UPCASE1 (c1); + if (! multibyte) + MAKE_CHAR_UNIBYTE (c); XSETFASTINT (obj, c | flags); } return obj; @@ -71,42 +78,43 @@ casify_object (flag, obj) if (STRINGP (obj)) { int multibyte = STRING_MULTIBYTE (obj); - int n; + int i, i_byte, len; + int size = SCHARS (obj); obj = Fcopy_sequence (obj); - len = SBYTES (obj); - - /* I counts bytes, and N counts chars. */ - for (i = n = 0; i < len; n++) + for (i = i_byte = 0; i < size; i++, i_byte += len) { - int from_len = 1, to_len = 1; - - c = SREF (obj, i); - - if (multibyte && c >= 0x80) - c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i, len -i, from_len); + if (multibyte) + c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, 0, len); + else + { + c = SREF (obj, i_byte); + len = 1; + MAKE_CHAR_MULTIBYTE (c); + } + c1 = c; if (inword && flag != CASE_CAPITALIZE_UP) c = DOWNCASE (c); else if (!UPPERCASEP (c) && (!inword || flag != CASE_CAPITALIZE_UP)) - c = UPCASE1 (c); - if ((ASCII_BYTE_P (c) && from_len == 1) - || (! multibyte && SINGLE_BYTE_CHAR_P (c))) - SSET (obj, i, c); - else + c = UPCASE1 (c1); + if ((int) flag >= (int) CASE_CAPITALIZE) + inword = (SYNTAX (c) == Sword); + if (c != c1) { - to_len = CHAR_BYTES (c); - if (from_len == to_len) - CHAR_STRING (c, SDATA (obj) + i); + if (! multibyte) + { + MAKE_CHAR_UNIBYTE (c); + SSET (obj, i_byte, c); + } + else if (ASCII_CHAR_P (c1) && ASCII_CHAR_P (c)) + SSET (obj, i_byte, c); else { - Faset (obj, make_number (n), make_number (c)); - len += to_len - from_len; + Faset (obj, make_number (i), make_number (c)); + i_byte += CHAR_BYTES (c) - len; } } - if ((int) flag >= (int) CASE_CAPITALIZE) - inword = SYNTAX (c) == Sword; - i += to_len; } return obj; } @@ -168,13 +176,14 @@ casify_region (flag, b, e) enum case_action flag; Lisp_Object b, e; { - register int i; register int c; register int inword = flag == CASE_DOWN; register int multibyte = !NILP (current_buffer->enable_multibyte_characters); int start, end; int start_byte, end_byte; int changed = 0; + int opoint = PT; + int opoint_byte = PT_BYTE; if (EQ (b, e)) /* Not modifying because nothing marked */ @@ -192,85 +201,74 @@ casify_region (flag, b, e) start_byte = CHAR_TO_BYTE (start); end_byte = CHAR_TO_BYTE (end); - for (i = start_byte; i < end_byte; i++, start++) + while (start < end) { - int c2; - c = c2 = FETCH_BYTE (i); - if (multibyte && c >= 0x80) - /* A multibyte character can't be handled in this simple loop. */ - break; + int c2, len; + + if (multibyte) + { + c = FETCH_MULTIBYTE_CHAR (start_byte); + len = CHAR_BYTES (c); + } + else + { + c = FETCH_BYTE (start_byte); + MAKE_CHAR_MULTIBYTE (c); + len = 1; + } + c2 = c; if (inword && flag != CASE_CAPITALIZE_UP) c = DOWNCASE (c); else if (!UPPERCASEP (c) && (!inword || flag != CASE_CAPITALIZE_UP)) c = UPCASE1 (c); - if (multibyte && c >= 0x80) - /* A multibyte result character can't be handled in this - simple loop. */ - break; - FETCH_BYTE (i) = c; - if (c != c2) - changed = 1; if ((int) flag >= (int) CASE_CAPITALIZE) - inword = SYNTAX (c) == Sword && (inword || !SYNTAX_PREFIX (c)); - } - if (i < end_byte) - { - /* The work is not yet finished because of a multibyte character - just encountered. */ - int opoint = PT; - int opoint_byte = PT_BYTE; - int c2; - - while (start < end) + inword = ((SYNTAX (c) == Sword) && (inword || !SYNTAX_PREFIX (c))); + if (c != c2) { - if ((c = FETCH_BYTE (i)) >= 0x80) - c = FETCH_MULTIBYTE_CHAR (i); - c2 = c; - if (inword && flag != CASE_CAPITALIZE_UP) - c2 = DOWNCASE (c); - else if (!UPPERCASEP (c) - && (!inword || flag != CASE_CAPITALIZE_UP)) - c2 = UPCASE1 (c); - if (c != c2) + changed = 1; + if (! multibyte) + { + MAKE_CHAR_UNIBYTE (c); + FETCH_BYTE (start_byte) = c; + } + else if (ASCII_CHAR_P (c2) && ASCII_CHAR_P (c)) + FETCH_BYTE (start_byte) = c; + else { - int fromlen, tolen, j; + int tolen = CHAR_BYTES (c); + int j; unsigned char str[MAX_MULTIBYTE_LENGTH]; - changed = 1; - /* Handle the most likely case */ - if (c < 0400 && c2 < 0400) - FETCH_BYTE (i) = c2; - else if (fromlen = CHAR_STRING (c, str), - tolen = CHAR_STRING (c2, str), - fromlen == tolen) + CHAR_STRING (c, str); + if (len == tolen) { /* Length is unchanged. */ - for (j = 0; j < tolen; ++j) - FETCH_BYTE (i + j) = str[j]; + for (j = 0; j < len; ++j) + FETCH_BYTE (start_byte + j) = str[j]; } else { /* Replace one character with the other, keeping text properties the same. */ - replace_range_2 (start, i, - start + 1, i + fromlen, + replace_range_2 (start, start_byte, + start + 1, start_byte + len, str, 1, tolen, - 1); - if (opoint > start) - opoint_byte += tolen - fromlen; + 0); + len = tolen; } } - if ((int) flag >= (int) CASE_CAPITALIZE) - inword = SYNTAX (c2) == Sword; - INC_BOTH (start, i); } - TEMP_SET_PT_BOTH (opoint, opoint_byte); + start++; + start_byte += len; } - start = XFASTINT (b); + if (PT != opoint) + TEMP_SET_PT_BOTH (opoint, opoint_byte); + if (changed) { + start = XFASTINT (b); signal_after_change (start, end - start, end - start); update_compositions (start, end, CHECK_ALL); } diff --git a/src/casetab.c b/src/casetab.c index 952a320dda3..bcd8e63cc7a 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -24,7 +24,7 @@ Boston, MA 02110-1301, USA. */ #include <config.h> #include "lisp.h" #include "buffer.h" -#include "charset.h" +#include "character.h" Lisp_Object Qcase_table_p, Qcase_table; Lisp_Object Vascii_downcase_table, Vascii_upcase_table; @@ -126,7 +126,6 @@ set_case_table (table, standard) int standard; { Lisp_Object up, canon, eqv; - int indices[3]; check_case_table (table); @@ -137,8 +136,8 @@ set_case_table (table, standard) if (NILP (up)) { up = Fmake_char_table (Qcase_table, Qnil); - map_char_table (set_identity, Qnil, table, table, up, 0, indices); - map_char_table (shuffle, Qnil, table, table, up, 0, indices); + map_char_table (set_identity, Qnil, table, up); + map_char_table (shuffle, Qnil, table, up); XCHAR_TABLE (table)->extras[0] = up; } @@ -146,14 +145,14 @@ set_case_table (table, standard) { canon = Fmake_char_table (Qcase_table, Qnil); XCHAR_TABLE (table)->extras[1] = canon; - map_char_table (set_canon, Qnil, table, table, table, 0, indices); + map_char_table (set_canon, Qnil, table, table); } if (NILP (eqv)) { eqv = Fmake_char_table (Qcase_table, Qnil); - map_char_table (set_identity, Qnil, canon, canon, eqv, 0, indices); - map_char_table (shuffle, Qnil, canon, canon, eqv, 0, indices); + map_char_table (set_identity, Qnil, canon, eqv); + map_char_table (shuffle, Qnil, canon, eqv); XCHAR_TABLE (table)->extras[2] = eqv; } @@ -180,30 +179,45 @@ set_case_table (table, standard) /* The following functions are called in map_char_table. */ -/* Set CANON char-table element for C to a translated ELT by UP and - DOWN char-tables. This is done only when ELT is a character. The - char-tables CANON, UP, and DOWN are in CASE_TABLE. */ +/* Set CANON char-table element for characters in RANGE to a + translated ELT by UP and DOWN char-tables. This is done only when + ELT is a character. The char-tables CANON, UP, and DOWN are in + CASE_TABLE. */ static void -set_canon (case_table, c, elt) - Lisp_Object case_table, c, elt; +set_canon (case_table, range, elt) + Lisp_Object case_table, range, elt; { Lisp_Object up = XCHAR_TABLE (case_table)->extras[0]; Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1]; if (NATNUMP (elt)) - Faset (canon, c, Faref (case_table, Faref (up, elt))); + Fset_char_table_range (canon, range, Faref (case_table, Faref (up, elt))); } -/* Set elements of char-table TABLE for C to C itself. This is done - only when ELT is a character. This is called in map_char_table. */ +/* Set elements of char-table TABLE for C to C itself. C may be a + cons specifying a character range. In that case, set characters in + that range to themselves. This is done only when ELT is a + character. This is called in map_char_table. */ static void set_identity (table, c, elt) Lisp_Object table, c, elt; { if (NATNUMP (elt)) - Faset (table, c, c); + { + int from, to; + + if (CONSP (c)) + { + from = XINT (XCAR (c)); + to = XINT (XCDR (c)); + } + else + from = to = XINT (c); + for (; from <= to; from++) + CHAR_TABLE_SET (table, from, make_number (from)); + } } /* Permute the elements of TABLE (which is initially an identity @@ -215,11 +229,25 @@ static void shuffle (table, c, elt) Lisp_Object table, c, elt; { - if (NATNUMP (elt) && !EQ (c, elt)) + if (NATNUMP (elt)) { Lisp_Object tem = Faref (table, elt); - Faset (table, elt, c); - Faset (table, c, tem); + int from, to; + + if (CONSP (c)) + { + from = XINT (XCAR (c)); + to = XINT (XCDR (c)); + } + else + from = to = XINT (c); + + for (; from <= to; from++) + if (from != XINT (elt)) + { + Faset (table, elt, make_number (from)); + Faset (table, make_number (from), tem); + } } } @@ -244,22 +272,24 @@ init_casetab_once () Vascii_downcase_table = down; XCHAR_TABLE (down)->purpose = Qcase_table; - for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) - XSETFASTINT (XCHAR_TABLE (down)->contents[i], - (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i); + for (i = 0; i < 128; i++) + { + int c = (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i; + CHAR_TABLE_SET (down, i, make_number (c)); + } XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down); up = Fmake_char_table (Qcase_table, Qnil); XCHAR_TABLE (down)->extras[0] = up; - for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) - XSETFASTINT (XCHAR_TABLE (up)->contents[i], - ((i >= 'A' && i <= 'Z') - ? i + ('a' - 'A') - : ((i >= 'a' && i <= 'z') - ? i + ('A' - 'a') - : i))); + for (i = 0; i < 128; i++) + { + int c = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A') + : ((i >= 'a' && i <= 'z') ? i + ('A' - 'a') + : i));; + CHAR_TABLE_SET (up, i, make_number (c)); + } XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up); diff --git a/src/category.c b/src/category.c index 7ea9b7810fa..708131d8e41 100644 --- a/src/category.c +++ b/src/category.c @@ -5,6 +5,9 @@ 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -31,6 +34,7 @@ Boston, MA 02110-1301, USA. */ #include <ctype.h> #include "lisp.h" #include "buffer.h" +#include "character.h" #include "charset.h" #include "category.h" #include "keymap.h" @@ -189,6 +193,18 @@ This is the one used for new buffers. */) return Vstandard_category_table; } + +static void +copy_category_entry (table, c, val) + Lisp_Object table, c, val; +{ + val = Fcopy_sequence (val); + if (CONSP (c)) + char_table_set_range (table, XINT (XCAR (c)), XINT (XCDR (c)), val); + else + char_table_set (table, XINT (c), val); +} + /* Return a copy of category table TABLE. We can't simply use the function copy-sequence because no contents should be shared between the original and the copy. This function is called recursively by @@ -198,44 +214,14 @@ Lisp_Object copy_category_table (table) Lisp_Object table; { - Lisp_Object tmp; - int i, to; + table = copy_char_table (table); - if (!NILP (XCHAR_TABLE (table)->top)) - { - /* TABLE is a top level char table. - At first, make a copy of tree structure of the table. */ - table = Fcopy_sequence (table); - - /* Then, copy elements for single byte characters one by one. */ - for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) - if (!NILP (tmp = XCHAR_TABLE (table)->contents[i])) - XCHAR_TABLE (table)->contents[i] = Fcopy_sequence (tmp); - to = CHAR_TABLE_ORDINARY_SLOTS; - - /* Also copy the first (and sole) extra slot. It is a vector - containing docstring of each category. */ - Fset_char_table_extra_slot - (table, make_number (0), - Fcopy_sequence (Fchar_table_extra_slot (table, make_number (0)))); - } - else - { - i = 32; - to = SUB_CHAR_TABLE_ORDINARY_SLOTS; - } - - /* If the table has non-nil default value, copy it. */ - if (!NILP (tmp = XCHAR_TABLE (table)->defalt)) - XCHAR_TABLE (table)->defalt = Fcopy_sequence (tmp); - - /* At last, copy the remaining elements while paying attention to a - sub char table. */ - for (; i < to; i++) - if (!NILP (tmp = XCHAR_TABLE (table)->contents[i])) - XCHAR_TABLE (table)->contents[i] - = (SUB_CHAR_TABLE_P (tmp) - ? copy_category_table (tmp) : Fcopy_sequence (tmp)); + if (! NILP (XCHAR_TABLE (table)->defalt)) + XCHAR_TABLE (table)->defalt + = Fcopy_sequence (XCHAR_TABLE (table)->defalt); + XCHAR_TABLE (table)->extras[0] + = Fcopy_sequence (XCHAR_TABLE (table)->extras[0]); + map_char_table (copy_category_entry, Qnil, table, table); return table; } @@ -261,9 +247,12 @@ DEFUN ("make-category-table", Fmake_category_table, Smake_category_table, () { Lisp_Object val; + int i; val = Fmake_char_table (Qcategory_table, Qnil); XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET; + for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++) + XCHAR_TABLE (val)->contents[i] = MAKE_CATEGORY_SET; Fset_char_table_extra_slot (val, make_number (0), Fmake_vector (make_number (95), Qnil)); return val; @@ -285,6 +274,13 @@ Return TABLE. */) } +Lisp_Object +char_category_set (c) + int c; +{ + return CHAR_TABLE_REF (current_buffer->category_table, c); +} + DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0, doc: /* Return the category set of CHAR. usage: (char-category-set CHAR) */) @@ -318,34 +314,6 @@ The return value is a string containing those same categories. */) return build_string (str); } -/* Modify all category sets stored under sub char-table TABLE so that - they contain (SET_VALUE is t) or don't contain (SET_VALUE is nil) - CATEGORY. */ - -void -modify_lower_category_set (table, category, set_value) - Lisp_Object table, category, set_value; -{ - Lisp_Object val; - int i; - - val = XCHAR_TABLE (table)->defalt; - if (!CATEGORY_SET_P (val)) - val = MAKE_CATEGORY_SET; - SET_CATEGORY_SET (val, category, set_value); - XCHAR_TABLE (table)->defalt = val; - - for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++) - { - val = XCHAR_TABLE (table)->contents[i]; - - if (CATEGORY_SET_P (val)) - SET_CATEGORY_SET (val, category, set_value); - else if (SUB_CHAR_TABLE_P (val)) - modify_lower_category_set (val, category, set_value); - } -} - void set_category_set (category_set, category, val) Lisp_Object category_set, category, val; @@ -365,113 +333,55 @@ DEFUN ("modify-category-entry", Fmodify_category_entry, Smodify_category_entry, 2, 4, 0, doc: /* Modify the category set of CHARACTER by adding CATEGORY to it. The category is changed only for table TABLE, which defaults to - the current buffer's category table. +the current buffer's category table. +CHARACTER can be either a single character or a cons representing the +lower and upper ends of an inclusive character range to modify. If optional fourth argument RESET is non-nil, then delete CATEGORY from the category set instead of adding it. */) (character, category, table, reset) Lisp_Object character, category, table, reset; { - int c, charset, c1, c2; Lisp_Object set_value; /* Actual value to be set in category sets. */ - Lisp_Object val, category_set; + Lisp_Object category_set; + int start, end; + int from, to; - CHECK_NUMBER (character); - c = XINT (character); - CHECK_CATEGORY (category); - table = check_category_table (table); - - if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category)))) - error ("Undefined category: %c", XFASTINT (category)); - - set_value = NILP (reset) ? Qt : Qnil; - - if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS) - { - val = XCHAR_TABLE (table)->contents[c]; - if (!CATEGORY_SET_P (val)) - XCHAR_TABLE (table)->contents[c] = (val = MAKE_CATEGORY_SET); - SET_CATEGORY_SET (val, category, set_value); - return Qnil; - } - - SPLIT_CHAR (c, charset, c1, c2); - - /* The top level table. */ - val = XCHAR_TABLE (table)->contents[charset + 128]; - if (CATEGORY_SET_P (val)) - category_set = val; - else if (!SUB_CHAR_TABLE_P (val)) - { - category_set = val = MAKE_CATEGORY_SET; - XCHAR_TABLE (table)->contents[charset + 128] = category_set; - } - - if (c1 <= 0) + if (INTEGERP (character)) { - /* Only a charset is specified. */ - if (SUB_CHAR_TABLE_P (val)) - /* All characters in CHARSET should be the same as for having - CATEGORY or not. */ - modify_lower_category_set (val, category, set_value); - else - SET_CATEGORY_SET (category_set, category, set_value); - return Qnil; + CHECK_CHARACTER (character); + start = end = XFASTINT (character); } - - /* The second level table. */ - if (!SUB_CHAR_TABLE_P (val)) + else { - val = make_sub_char_table (Qnil); - XCHAR_TABLE (table)->contents[charset + 128] = val; - /* We must set default category set of CHARSET in `defalt' slot. */ - XCHAR_TABLE (val)->defalt = category_set; + CHECK_CONS (character); + CHECK_CHARACTER_CAR (character); + CHECK_CHARACTER_CDR (character); + start = XFASTINT (XCAR (character)); + end = XFASTINT (XCDR (character)); } - table = val; - val = XCHAR_TABLE (table)->contents[c1]; - if (CATEGORY_SET_P (val)) - category_set = val; - else if (!SUB_CHAR_TABLE_P (val)) - { - category_set = val = Fcopy_sequence (XCHAR_TABLE (table)->defalt); - XCHAR_TABLE (table)->contents[c1] = category_set; - } + CHECK_CATEGORY (category); + table = check_category_table (table); - if (c2 <= 0) - { - if (SUB_CHAR_TABLE_P (val)) - /* All characters in C1 group of CHARSET should be the same as - for CATEGORY. */ - modify_lower_category_set (val, category, set_value); - else - SET_CATEGORY_SET (category_set, category, set_value); - return Qnil; - } + if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category)))) + error ("Undefined category: %c", XFASTINT (category)); - /* The third (bottom) level table. */ - if (!SUB_CHAR_TABLE_P (val)) - { - val = make_sub_char_table (Qnil); - XCHAR_TABLE (table)->contents[c1] = val; - /* We must set default category set of CHARSET and C1 in - `defalt' slot. */ - XCHAR_TABLE (val)->defalt = category_set; - } - table = val; + set_value = NILP (reset) ? Qt : Qnil; - val = XCHAR_TABLE (table)->contents[c2]; - if (CATEGORY_SET_P (val)) - category_set = val; - else if (!SUB_CHAR_TABLE_P (val)) + while (start <= end) { - category_set = Fcopy_sequence (XCHAR_TABLE (table)->defalt); - XCHAR_TABLE (table)->contents[c2] = category_set; + category_set = char_table_ref_and_range (table, start, &from, &to); + if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset)) + { + category_set = Fcopy_sequence (category_set); + SET_CATEGORY_SET (category_set, category, set_value); + if (to > end) + char_table_set_range (table, start, end, category_set); + else + char_table_set_range (table, start, to, category_set); + } + start = to + 1; } - else - /* This should never happen. */ - error ("Invalid category table"); - - SET_CATEGORY_SET (category_set, category, set_value); return Qnil; } diff --git a/src/category.h b/src/category.h index be534fb47f5..3687e06ce1f 100644 --- a/src/category.h +++ b/src/category.h @@ -3,6 +3,9 @@ 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -93,21 +96,7 @@ extern Lisp_Object _temp_category_set; #define Vstandard_category_table buffer_defaults.category_table /* Return the category set of character C in the current category table. */ -#ifdef __GNUC__ -#define CATEGORY_SET(c) \ - ({ Lisp_Object table = current_buffer->category_table; \ - Lisp_Object temp; \ - if ((c) < CHAR_TABLE_SINGLE_BYTE_SLOTS) \ - while (NILP (temp = XCHAR_TABLE (table)->contents[(unsigned char) c]) \ - && NILP (temp = XCHAR_TABLE (table)->defalt)) \ - table = XCHAR_TABLE (table)->parent; \ - else \ - temp = Faref (table, make_number (c)); \ - temp; }) -#else -#define CATEGORY_SET(c) \ - Faref (current_buffer->category_table, make_number (c)) -#endif +#define CATEGORY_SET(c) char_category_set (c) /* Return the doc string of CATEGORY in category table TABLE. */ #define CATEGORY_DOCSTRING(table, category) \ @@ -120,8 +109,8 @@ extern Lisp_Object _temp_category_set; /* Return 1 if there is a word boundary between two word-constituent characters C1 and C2 if they appear in this order, else return 0. - There is no word boundary between two word-constituent ASCII - characters. */ + There is no word boundary between two word-constituent ASCII and + Latin-1 characters. */ #define WORD_BOUNDARY_P(c1, c2) \ (!(SINGLE_BYTE_CHAR_P (c1) && SINGLE_BYTE_CHAR_P (c2)) \ && word_boundary_p (c1, c2)) diff --git a/src/ccl.c b/src/ccl.c index 3ef342f455e..5e4a6632d1d 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -5,6 +5,9 @@ 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -28,10 +31,13 @@ Boston, MA 02110-1301, USA. */ #include <stdio.h> #include "lisp.h" +#include "character.h" #include "charset.h" #include "ccl.h" #include "coding.h" +Lisp_Object Qccl, Qcclp; + /* This contains all code conversion map available to CCL. */ Lisp_Object Vcode_conversion_map_vector; @@ -67,6 +73,8 @@ Lisp_Object Vtranslation_hash_table_vector; #define GET_HASH_TABLE(id) \ (XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)]))) +extern int charset_unicode; + /* CCL (Code Conversion Language) is a simple language which has operations on one input buffer, one output buffer, and 7 registers. The syntax of CCL is described in `ccl.el'. Emacs Lisp function @@ -199,10 +207,13 @@ Lisp_Object Vtranslation_hash_table_vector; #define CCL_WriteStringJump 0x0A /* Write string and jump: 1:A--D--D--R--E--S--S-000XXXXX 2:LENGTH - 3:0000STRIN[0]STRIN[1]STRIN[2] + 3:000MSTRIN[0]STRIN[1]STRIN[2] ... ------------------------------ - write_string (STRING, LENGTH); + if (M) + write_multibyte_string (STRING, LENGTH); + else + write_string (STRING, LENGTH); IC += ADDRESS; */ @@ -309,13 +320,16 @@ Lisp_Object Vtranslation_hash_table_vector; #define CCL_WriteConstString 0x14 /* Write a constant or a string: 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX - [2:0000STRIN[0]STRIN[1]STRIN[2]] + [2:000MSTRIN[0]STRIN[1]STRIN[2]] [...] ----------------------------- if (!rrr) write (CC..C) else - write_string (STRING, CC..C); + if (M) + write_multibyte_string (STRING, CC..C); + else + write_string (STRING, CC..C); IC += (CC..C + 2) / 3; */ @@ -743,136 +757,87 @@ while(0) /* Encode one character CH to multibyte form and write to the current output buffer. If CH is less than 256, CH is written as is. */ -#define CCL_WRITE_CHAR(ch) \ - do { \ - int bytes = SINGLE_BYTE_CHAR_P (ch) ? 1: CHAR_BYTES (ch); \ - if (!dst) \ - CCL_INVALID_CMD; \ - else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \ - { \ - if (bytes == 1) \ - { \ - *dst++ = (ch); \ - if (extra_bytes && (ch) >= 0x80 && (ch) < 0xA0) \ - /* We may have to convert this eight-bit char to \ - multibyte form later. */ \ - extra_bytes++; \ - } \ - else if (CHAR_VALID_P (ch, 0)) \ - dst += CHAR_STRING (ch, dst); \ - else \ - CCL_INVALID_CMD; \ - } \ - else \ - CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ - } while (0) - -/* Encode one character CH to multibyte form and write to the current - output buffer. The output bytes always forms a valid multibyte - sequence. */ -#define CCL_WRITE_MULTIBYTE_CHAR(ch) \ - do { \ - int bytes = CHAR_BYTES (ch); \ - if (!dst) \ - CCL_INVALID_CMD; \ - else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \ - { \ - if (CHAR_VALID_P ((ch), 0)) \ - dst += CHAR_STRING ((ch), dst); \ - else \ - CCL_INVALID_CMD; \ - } \ - else \ - CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ +#define CCL_WRITE_CHAR(ch) \ + do { \ + if (! dst) \ + CCL_INVALID_CMD; \ + else if (dst < dst_end) \ + *dst++ = (ch); \ + else \ + CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ } while (0) /* Write a string at ccl_prog[IC] of length LEN to the current output buffer. */ -#define CCL_WRITE_STRING(len) \ - do { \ - if (!dst) \ - CCL_INVALID_CMD; \ - else if (dst + len <= (dst_bytes ? dst_end : src)) \ - for (i = 0; i < len; i++) \ - *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \ - >> ((2 - (i % 3)) * 8)) & 0xFF; \ - else \ - CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ - } while (0) - -/* Read one byte from the current input buffer into REGth register. */ -#define CCL_READ_CHAR(REG) \ - do { \ - if (!src) \ - CCL_INVALID_CMD; \ - else if (src < src_end) \ - { \ - REG = *src++; \ - if (REG == '\n' \ - && ccl->eol_type != CODING_EOL_LF) \ - { \ - /* We are encoding. */ \ - if (ccl->eol_type == CODING_EOL_CRLF) \ - { \ - if (ccl->cr_consumed) \ - ccl->cr_consumed = 0; \ - else \ - { \ - ccl->cr_consumed = 1; \ - REG = '\r'; \ - src--; \ - } \ - } \ - else \ - REG = '\r'; \ - } \ - if (REG == LEADING_CODE_8_BIT_CONTROL \ - && ccl->multibyte) \ - REG = *src++ - 0x20; \ - } \ - else if (ccl->last_block) \ - { \ - REG = -1; \ - ic = eof_ic; \ - goto ccl_repeat; \ - } \ - else \ - CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \ - } while (0) - - -/* Set C to the character code made from CHARSET and CODE. This is - like MAKE_CHAR but check the validity of CHARSET and CODE. If they - are not valid, set C to (CODE & 0xFF) because that is usually the - case that CCL_ReadMultibyteChar2 read an invalid code and it set - CODE to that invalid byte. */ - -#define CCL_MAKE_CHAR(charset, code, c) \ +#define CCL_WRITE_STRING(len) \ do { \ - if (charset == CHARSET_ASCII) \ - c = code & 0xFF; \ - else if (CHARSET_DEFINED_P (charset) \ - && (code & 0x7F) >= 32 \ - && (code < 256 || ((code >> 7) & 0x7F) >= 32)) \ + int i; \ + if (!dst) \ + CCL_INVALID_CMD; \ + else if (dst + len <= dst_end) \ { \ - int c1 = code & 0x7F, c2 = 0; \ - \ - if (code >= 256) \ - c2 = c1, c1 = (code >> 7) & 0x7F; \ - c = MAKE_CHAR (charset, c1, c2); \ + if (XFASTINT (ccl_prog[ic]) & 0x1000000) \ + for (i = 0; i < len; i++) \ + *dst++ = XFASTINT (ccl_prog[ic + i]) & 0xFFFFFF; \ + else \ + for (i = 0; i < len; i++) \ + *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \ + >> ((2 - (i % 3)) * 8)) & 0xFF; \ } \ else \ - c = code & 0xFF; \ + CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \ } while (0) +/* Read one byte from the current input buffer into Rth register. */ +#define CCL_READ_CHAR(r) \ + do { \ + if (! src) \ + CCL_INVALID_CMD; \ + else if (src < src_end) \ + r = *src++; \ + else if (ccl->last_block) \ + { \ + r = -1; \ + ic = ccl->eof_ic; \ + goto ccl_repeat; \ + } \ + else \ + CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \ + } while (0) + +/* Decode CODE by a charset whose id is ID. If ID is 0, return CODE + as is for backward compatibility. Assume that we can use the + variable `charset'. */ + +#define CCL_DECODE_CHAR(id, code) \ + ((id) == 0 ? (code) \ + : (charset = CHARSET_FROM_ID ((id)), DECODE_CHAR (charset, (code)))) + +/* Encode character C by some of charsets in CHARSET_LIST. Set ID to + the id of the used charset, ENCODED to the resulf of encoding. + Assume that we can use the variable `charset'. */ + +#define CCL_ENCODE_CHAR(c, charset_list, id, encoded) \ + do { \ + unsigned code; \ + \ + charset = char_charset ((c), (charset_list), &code); \ + if (! charset && ! NILP (charset_list)) \ + charset = char_charset ((c), Qnil, &code); \ + if (charset) \ + { \ + (id) = CHARSET_ID (charset); \ + (encoded) = code; \ + } \ + } while (0) -/* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting - text goes to a place pointed by DESTINATION, the length of which - should not exceed DST_BYTES. The bytes actually processed is - returned as *CONSUMED. The return value is the length of the - resulting text. As a side effect, the contents of CCL registers - are updated. If SOURCE or DESTINATION is NULL, only operations on - registers are permitted. */ +/* Execute CCL code on characters at SOURCE (length SRC_SIZE). The + resulting text goes to a place pointed by DESTINATION, the length + of which should not exceed DST_SIZE. As a side effect, how many + characters are consumed and produced are recorded in CCL->consumed + and CCL->produced, and the contents of CCL registers are updated. + If SOURCE or DESTINATION is NULL, only operations on registers are + permitted. */ #ifdef CCL_DEBUG #define CCL_DEBUG_BACKTRACE_LEN 256 @@ -897,36 +862,32 @@ struct ccl_prog_stack /* For the moment, we only support depth 256 of stack. */ static struct ccl_prog_stack ccl_prog_stack_struct[256]; -int -ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) +void +ccl_driver (ccl, source, destination, src_size, dst_size, charset_list) struct ccl_program *ccl; - unsigned char *source, *destination; - int src_bytes, dst_bytes; - int *consumed; + int *source, *destination; + int src_size, dst_size; + Lisp_Object charset_list; { register int *reg = ccl->reg; register int ic = ccl->ic; register int code = 0, field1, field2; register Lisp_Object *ccl_prog = ccl->prog; - unsigned char *src = source, *src_end = src + src_bytes; - unsigned char *dst = destination, *dst_end = dst + dst_bytes; + int *src = source, *src_end = src + src_size; + int *dst = destination, *dst_end = dst + dst_size; int jump_address; int i = 0, j, op; int stack_idx = ccl->stack_idx; /* Instruction counter of the current CCL code. */ int this_ic = 0; - /* CCL_WRITE_CHAR will produce 8-bit code of range 0x80..0x9F. But, - each of them will be converted to multibyte form of 2-byte - sequence. For that conversion, we remember how many more bytes - we must keep in DESTINATION in this variable. */ - int extra_bytes = ccl->eight_bit_control; + struct charset *charset; int eof_ic = ccl->eof_ic; int eof_hit = 0; if (ic >= eof_ic) ic = CCL_HEADER_MAIN; - if (ccl->buf_magnification == 0) /* We can't produce any bytes. */ + if (ccl->buf_magnification == 0) /* We can't read/produce any bytes. */ dst = NULL; /* Set mapping stack pointer. */ @@ -951,8 +912,8 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) /* We can't just signal Qquit, instead break the loop as if the whole data is processed. Don't reset Vquit_flag, it must be handled later at a safer place. */ - if (consumed) - src = source + src_bytes; + if (src) + src = source + src_size; ccl->status = CCL_STAT_QUIT; break; } @@ -1273,8 +1234,22 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) case CCL_LE: reg[rrr] = i <= j; break; case CCL_GE: reg[rrr] = i >= j; break; case CCL_NE: reg[rrr] = i != j; break; - case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break; - case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break; + case CCL_DECODE_SJIS: + { + i = (i << 8) | j; + SJIS_TO_JIS (i); + reg[rrr] = i >> 8; + reg[7] = i & 0xFF; + break; + } + case CCL_ENCODE_SJIS: + { + i = (i << 8) | j; + JIS_TO_SJIS (i); + reg[rrr] = i >> 8; + reg[7] = i & 0xFF; + break; + } default: CCL_INVALID_CMD; } code &= 0x1F; @@ -1294,166 +1269,29 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) case CCL_ReadMultibyteChar2: if (!src) CCL_INVALID_CMD; - - if (src >= src_end) - { - src++; - goto ccl_read_multibyte_character_suspend; - } - - if (!ccl->multibyte) - { - int bytes; - if (!UNIBYTE_STR_AS_MULTIBYTE_P (src, src_end - src, bytes)) - { - reg[RRR] = CHARSET_8_BIT_CONTROL; - reg[rrr] = *src++; - break; - } - } - i = *src++; - if (i == '\n' && ccl->eol_type != CODING_EOL_LF) - { - /* We are encoding. */ - if (ccl->eol_type == CODING_EOL_CRLF) - { - if (ccl->cr_consumed) - ccl->cr_consumed = 0; - else - { - ccl->cr_consumed = 1; - i = '\r'; - src--; - } - } - else - i = '\r'; - reg[rrr] = i; - reg[RRR] = CHARSET_ASCII; - } - else if (i < 0x80) - { - /* ASCII */ - reg[rrr] = i; - reg[RRR] = CHARSET_ASCII; - } - else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2) - { - int dimension = BYTES_BY_CHAR_HEAD (i) - 1; - - if (dimension == 0) - { - /* `i' is a leading code for an undefined charset. */ - reg[RRR] = CHARSET_8_BIT_GRAPHIC; - reg[rrr] = i; - } - else if (src + dimension > src_end) - goto ccl_read_multibyte_character_suspend; - else - { - reg[RRR] = i; - i = (*src++ & 0x7F); - if (dimension == 1) - reg[rrr] = i; - else - reg[rrr] = ((i << 7) | (*src++ & 0x7F)); - } - } - else if ((i == LEADING_CODE_PRIVATE_11) - || (i == LEADING_CODE_PRIVATE_12)) - { - if ((src + 1) >= src_end) - goto ccl_read_multibyte_character_suspend; - reg[RRR] = *src++; - reg[rrr] = (*src++ & 0x7F); - } - else if ((i == LEADING_CODE_PRIVATE_21) - || (i == LEADING_CODE_PRIVATE_22)) - { - if ((src + 2) >= src_end) - goto ccl_read_multibyte_character_suspend; - reg[RRR] = *src++; - i = (*src++ & 0x7F); - reg[rrr] = ((i << 7) | (*src & 0x7F)); - src++; - } - else if (i == LEADING_CODE_8_BIT_CONTROL) - { - if (src >= src_end) - goto ccl_read_multibyte_character_suspend; - reg[RRR] = CHARSET_8_BIT_CONTROL; - reg[rrr] = (*src++ - 0x20); - } - else if (i >= 0xA0) - { - reg[RRR] = CHARSET_8_BIT_GRAPHIC; - reg[rrr] = i; - } - else - { - /* INVALID CODE. Return a single byte character. */ - reg[RRR] = CHARSET_ASCII; - reg[rrr] = i; - } - break; - - ccl_read_multibyte_character_suspend: - if (src <= src_end && !ccl->multibyte && ccl->last_block) - { - reg[RRR] = CHARSET_8_BIT_CONTROL; - reg[rrr] = i; - break; - } - src--; - if (ccl->last_block) - { - ic = eof_ic; - eof_hit = 1; - goto ccl_repeat; - } - else - CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); - + CCL_READ_CHAR (i); + CCL_ENCODE_CHAR (i, charset_list, reg[RRR], reg[rrr]); break; case CCL_WriteMultibyteChar2: - i = reg[RRR]; /* charset */ - if (i == CHARSET_ASCII - || i == CHARSET_8_BIT_CONTROL - || i == CHARSET_8_BIT_GRAPHIC) - i = reg[rrr] & 0xFF; - else if (CHARSET_DIMENSION (i) == 1) - i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F); - else if (i < MIN_CHARSET_PRIVATE_DIMENSION2) - i = ((i - 0x8F) << 14) | reg[rrr]; - else - i = ((i - 0xE0) << 14) | reg[rrr]; - - CCL_WRITE_MULTIBYTE_CHAR (i); - + if (! dst) + CCL_INVALID_CMD; + i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); + CCL_WRITE_CHAR (i); break; case CCL_TranslateCharacter: - CCL_MAKE_CHAR (reg[RRR], reg[rrr], i); - op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]), - i, -1, 0, 0); - SPLIT_CHAR (op, reg[RRR], i, j); - if (j != -1) - i = (i << 7) | j; - - reg[rrr] = i; + i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); + op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]), i); + CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]); break; case CCL_TranslateCharacterConstTbl: op = XINT (ccl_prog[ic]); /* table */ ic++; - CCL_MAKE_CHAR (reg[RRR], reg[rrr], i); - op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0); - SPLIT_CHAR (op, reg[RRR], i, j); - if (j != -1) - i = (i << 7) | j; - - reg[rrr] = i; + i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); + op = translate_char (GET_TRANSLATION_TABLE (op), i); + CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]); break; case CCL_LookupIntConstTbl: @@ -1467,12 +1305,10 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) { Lisp_Object opl; opl = HASH_VALUE (h, op); - if (!CHAR_VALID_P (XINT (opl), 0)) + if (! CHARACTERP (opl)) CCL_INVALID_CMD; - SPLIT_CHAR (XINT (opl), reg[RRR], i, j); - if (j != -1) - i = (i << 7) | j; - reg[rrr] = i; + reg[RRR] = charset_unicode; + reg[rrr] = op; reg[7] = 1; /* r7 true for success */ } else @@ -1483,7 +1319,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) case CCL_LookupCharConstTbl: op = XINT (ccl_prog[ic]); /* table */ ic++; - CCL_MAKE_CHAR (reg[RRR], reg[rrr], i); + i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]); { struct Lisp_Hash_Table *h = GET_HASH_TABLE (op); @@ -1917,10 +1753,10 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) } msglen = strlen (msg); - if (dst + msglen <= (dst_bytes ? dst_end : src)) + if (dst + msglen <= dst_end) { - bcopy (msg, dst, msglen); - dst += msglen; + for (i = 0; i < msglen; i++) + *dst++ = msg[i]; } if (ccl->status == CCL_STAT_INVALID_CMD) @@ -1946,10 +1782,11 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed) ccl->ic = ic; ccl->stack_idx = stack_idx; ccl->prog = ccl_prog; - ccl->eight_bit_control = (extra_bytes > 1); - if (consumed) - *consumed = src - source; - return (dst ? dst - destination : 0); + ccl->consumed = src - source; + if (dst != NULL) + ccl->produced = dst - destination; + else + ccl->produced = 0; } /* Resolve symbols in the specified CCL code (Lisp vector). This @@ -2109,7 +1946,6 @@ setup_ccl_program (ccl, ccl_prog) ccl->private_state = 0; ccl->status = 0; ccl->stack_idx = 0; - ccl->eol_type = CODING_EOL_LF; ccl->suppress_error = 0; ccl->eight_bit_control = 0; return 0; @@ -2197,7 +2033,7 @@ programs. */) ? XINT (AREF (reg, i)) : 0); - ccl_driver (&ccl, (unsigned char *)0, (unsigned char *)0, 0, 0, (int *)0); + ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil); QUIT; if (ccl.status != CCL_STAT_SUCCESS) error ("Error in CCL program at %dth code", ccl.ic); @@ -2239,10 +2075,13 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY { Lisp_Object val; struct ccl_program ccl; - int i, produced; + int i; int outbufsize; - char *outbuf; - struct gcpro gcpro1, gcpro2; + unsigned char *outbuf, *outp; + int str_chars, str_bytes; +#define CCL_EXECUTE_BUF_SIZE 1024 + int source[CCL_EXECUTE_BUF_SIZE], destination[CCL_EXECUTE_BUF_SIZE]; + int consumed_chars, consumed_bytes, produced_chars; if (setup_ccl_program (&ccl, ccl_prog) < 0) error ("Invalid CCL program"); @@ -2252,7 +2091,8 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY error ("Length of vector STATUS is not 9"); CHECK_STRING (str); - GCPRO2 (status, str); + str_chars = SCHARS (str); + str_bytes = SBYTES (str); for (i = 0; i < 8; i++) { @@ -2267,33 +2107,90 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY if (ccl.ic < i && i < ccl.size) ccl.ic = i; } - outbufsize = SBYTES (str) * ccl.buf_magnification + 256; - outbuf = (char *) xmalloc (outbufsize); - ccl.last_block = NILP (contin); - ccl.multibyte = STRING_MULTIBYTE (str); - produced = ccl_driver (&ccl, SDATA (str), outbuf, - SBYTES (str), outbufsize, (int *) 0); + + outbufsize = (ccl.buf_magnification + ? str_bytes * ccl.buf_magnification + 256 + : str_bytes + 256); + outp = outbuf = (unsigned char *) xmalloc (outbufsize); + + consumed_chars = consumed_bytes = 0; + produced_chars = 0; + while (1) + { + const unsigned char *p = SDATA (str) + consumed_bytes; + const unsigned char *endp = SDATA (str) + str_bytes; + int i = 0; + int *src, src_size; + + if (endp - p == str_chars - consumed_chars) + while (i < CCL_EXECUTE_BUF_SIZE && p < endp) + source[i++] = *p++; + else + while (i < CCL_EXECUTE_BUF_SIZE && p < endp) + source[i++] = STRING_CHAR_ADVANCE (p); + consumed_chars += i; + consumed_bytes = p - SDATA (str); + + if (consumed_bytes == str_bytes) + ccl.last_block = NILP (contin); + src = source; + src_size = i; + while (1) + { + ccl_driver (&ccl, src, destination, src_size, CCL_EXECUTE_BUF_SIZE, + Qnil); + produced_chars += ccl.produced; + if (NILP (unibyte_p)) + { + if (outp - outbuf + MAX_MULTIBYTE_LENGTH * ccl.produced + > outbufsize) + { + int offset = outp - outbuf; + outbufsize += MAX_MULTIBYTE_LENGTH * ccl.produced; + outbuf = (unsigned char *) xrealloc (outbuf, outbufsize); + outp = outbuf + offset; + } + for (i = 0; i < ccl.produced; i++) + CHAR_STRING_ADVANCE (destination[i], outp); + } + else + { + if (outp - outbuf + ccl.produced > outbufsize) + { + int offset = outp - outbuf; + outbufsize += ccl.produced; + outbuf = (unsigned char *) xrealloc (outbuf, outbufsize); + outp = outbuf + offset; + } + for (i = 0; i < ccl.produced; i++) + *outp++ = destination[i]; + } + src += ccl.consumed; + src_size -= ccl.consumed; + if (ccl.status != CCL_STAT_SUSPEND_BY_DST) + break; + } + + if (ccl.status != CCL_STAT_SUSPEND_BY_SRC + || str_chars == consumed_chars) + break; + } + + if (ccl.status == CCL_STAT_INVALID_CMD) + error ("Error in CCL program at %dth code", ccl.ic); + if (ccl.status == CCL_STAT_QUIT) + error ("CCL program interrupted at %dth code", ccl.ic); + for (i = 0; i < 8; i++) ASET (status, i, make_number (ccl.reg[i])); ASET (status, 8, make_number (ccl.ic)); - UNGCPRO; if (NILP (unibyte_p)) - { - int nchars; - - produced = str_as_multibyte (outbuf, outbufsize, produced, &nchars); - val = make_multibyte_string (outbuf, nchars, produced); - } + val = make_multibyte_string ((char *) outbuf, produced_chars, + outp - outbuf); else - val = make_unibyte_string (outbuf, produced); + val = make_unibyte_string ((char *) outbuf, produced_chars); xfree (outbuf); - QUIT; - if (ccl.status == CCL_STAT_SUSPEND_BY_DST) - error ("Output buffer for the CCL programs overflow"); - if (ccl.status != CCL_STAT_SUCCESS - && ccl.status != CCL_STAT_SUSPEND_BY_SRC) - error ("Error in CCL program at %dth code", ccl.ic); return val; } @@ -2425,6 +2322,12 @@ syms_of_ccl () staticpro (&Vccl_program_table); Vccl_program_table = Fmake_vector (make_number (32), Qnil); + Qccl = intern ("ccl"); + staticpro (&Qccl); + + Qcclp = intern ("cclp"); + staticpro (&Qcclp); + Qccl_program = intern ("ccl-program"); staticpro (&Qccl_program); diff --git a/src/ccl.h b/src/ccl.h index 7199170a15c..d76038c857d 100644 --- a/src/ccl.h +++ b/src/ccl.h @@ -3,6 +3,9 @@ 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -59,16 +62,14 @@ struct ccl_program { many times bigger the output buffer should be than the input buffer. */ int stack_idx; /* How deep the call of CCL_Call is nested. */ - int eol_type; /* When the CCL program is used for - encoding by a coding system, set to - the eol_type of the coding system. - In other cases, always - CODING_EOL_LF. */ - int multibyte; /* 1 if the source text is multibyte. */ + int src_multibyte; /* 1 if the input buffer is multibyte. */ + int dst_multibyte; /* 1 if the output buffer is multibyte. */ int cr_consumed; /* Flag for encoding DOS-like EOL format when the CCL program is used for encoding by a coding system. */ + int consumed; + int produced; int suppress_error; /* If nonzero, don't insert error message in the output. */ int eight_bit_control; /* If nonzero, ccl_driver counts all @@ -82,13 +83,13 @@ struct ccl_program { coding_system. */ struct ccl_spec { - struct ccl_program decoder; - struct ccl_program encoder; - unsigned char valid_codes[256]; + struct ccl_program ccl; int cr_carryover; /* CR carryover flag. */ unsigned char eight_bit_carryover[MAX_MULTIBYTE_LENGTH]; }; +#define CODING_SPEC_CCL_PROGRAM(coding) ((coding)->spec.ccl.ccl) + /* Alist of fontname patterns vs corresponding CCL program. */ extern Lisp_Object Vfont_ccl_encoder_alist; @@ -99,8 +100,8 @@ extern int setup_ccl_program P_ ((struct ccl_program *, Lisp_Object)); /* Check if CCL is updated or not. If not, re-setup members of CCL. */ extern int check_ccl_update P_ ((struct ccl_program *)); -extern int ccl_driver P_ ((struct ccl_program *, unsigned char *, - unsigned char *, int, int, int *)); +extern void ccl_driver P_ ((struct ccl_program *, int *, int *, int, int, + Lisp_Object)); /* Vector of CCL program names vs corresponding program data. */ extern Lisp_Object Vccl_program_table; @@ -109,6 +110,16 @@ extern Lisp_Object Vccl_program_table; is an index for Vccl_protram_table. */ extern Lisp_Object Qccl_program_idx; +extern Lisp_Object Qccl, Qcclp; + +EXFUN (Fccl_program_p, 1); + +#define CHECK_CCL_PROGRAM(x) \ + do { \ + if (NILP (Fccl_program_p (x))) \ + x = wrong_type_argument (Qcclp, (x)); \ + } while (0); + #endif /* EMACS_CCL_H */ /* arch-tag: 14681df7-876d-43de-bc71-6b78e23a4e3c diff --git a/src/character.c b/src/character.c new file mode 100644 index 00000000000..15a2c45fdf8 --- /dev/null +++ b/src/character.c @@ -0,0 +1,1041 @@ +/* Basic character support. + Copyright (C) 1995, 1997, 1998, 2001 Electrotechnical Laboratory, JAPAN. + Licensed to the Free Software Foundation. + Copyright (C) 2001, 2005, 2006 Free Software Foundation, Inc. + Copyright (C) 2003, 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* At first, see the document in `character.h' to understand the code + in this file. */ + +#ifdef emacs +#include <config.h> +#endif + +#include <stdio.h> + +#ifdef emacs + +#include <sys/types.h> +#include "lisp.h" +#include "character.h" +#include "buffer.h" +#include "charset.h" +#include "composite.h" +#include "disptab.h" + +#else /* not emacs */ + +#include "mulelib.h" + +#endif /* emacs */ + +Lisp_Object Qcharacterp; + +/* Vector of translation table ever defined. + ID of a translation table is used to index this vector. */ +Lisp_Object Vtranslation_table_vector; + +/* A char-table for characters which may invoke auto-filling. */ +Lisp_Object Vauto_fill_chars; + +Lisp_Object Qauto_fill_chars; + +/* Char-table of information about which character to unify to which + Unicode character. */ +Lisp_Object Vchar_unify_table; + +/* A char-table. An element is non-nil iff the corresponding + character has a printable glyph. */ +Lisp_Object Vprintable_chars; + +/* A char-table. An elemnent is a column-width of the corresponding + character. */ +Lisp_Object Vchar_width_table; + +/* A char-table. An element is a symbol indicating the direction + property of corresponding character. */ +Lisp_Object Vchar_direction_table; + +/* Variable used locally in the macro FETCH_MULTIBYTE_CHAR. */ +unsigned char *_fetch_multibyte_char_p; + +/* Char table of scripts. */ +Lisp_Object Vchar_script_table; + +/* Alist of scripts vs representative characters. */ +Lisp_Object Vscript_representative_chars; + +static Lisp_Object Qchar_script_table; + +/* Mapping table from unibyte chars to multibyte chars. */ +int unibyte_to_multibyte_table[256]; + +/* Nth element is 1 iff unibyte char N can be mapped to a multibyte + char. */ +char unibyte_has_multibyte_table[256]; + + + +/* Store multibyte form of character C at P. If C has modifier bits, + handle them appropriately. */ + +int +char_string (c, p) + unsigned c; + unsigned char *p; +{ + int bytes; + + if (c & CHAR_MODIFIER_MASK) + { + /* As an non-ASCII character can't have modifier bits, we just + ignore the bits. */ + if (ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) + { + /* For Meta, Shift, and Control modifiers, we need special care. */ + if (c & CHAR_META) + { + /* Move the meta bit to the right place for a string. */ + c = (c & ~CHAR_META) | 0x80; + } + if (c & CHAR_SHIFT) + { + /* Shift modifier is valid only with [A-Za-z]. */ + if ((c & 0377) >= 'A' && (c & 0377) <= 'Z') + c &= ~CHAR_SHIFT; + else if ((c & 0377) >= 'a' && (c & 0377) <= 'z') + c = (c & ~CHAR_SHIFT) - ('a' - 'A'); + } + if (c & CHAR_CTL) + { + /* Simulate the code in lread.c. */ + /* Allow `\C- ' and `\C-?'. */ + if (c == (CHAR_CTL | ' ')) + c = 0; + else if (c == (CHAR_CTL | '?')) + c = 127; + /* ASCII control chars are made from letters (both cases), + as well as the non-letters within 0100...0137. */ + else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) + c &= (037 | (~0177 & ~CHAR_CTL)); + else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) + c &= (037 | (~0177 & ~CHAR_CTL)); + } + } + + /* If C still has any modifier bits, just ignore it. */ + c &= ~CHAR_MODIFIER_MASK; + } + + MAYBE_UNIFY_CHAR (c); + + if (c <= MAX_3_BYTE_CHAR) + { + bytes = CHAR_STRING (c, p); + } + else if (c <= MAX_4_BYTE_CHAR) + { + p[0] = (0xF0 | (c >> 18)); + p[1] = (0x80 | ((c >> 12) & 0x3F)); + p[2] = (0x80 | ((c >> 6) & 0x3F)); + p[3] = (0x80 | (c & 0x3F)); + bytes = 4; + } + else if (c <= MAX_5_BYTE_CHAR) + { + p[0] = 0xF8; + p[1] = (0x80 | ((c >> 18) & 0x0F)); + p[2] = (0x80 | ((c >> 12) & 0x3F)); + p[3] = (0x80 | ((c >> 6) & 0x3F)); + p[4] = (0x80 | (c & 0x3F)); + bytes = 5; + } + else if (c <= MAX_CHAR) + { + c = CHAR_TO_BYTE8 (c); + bytes = BYTE8_STRING (c, p); + } + else + error ("Invalid character: %d", c); + + return bytes; +} + + +/* Return a character whose multibyte form is at P. Set LEN is not + NULL, it must be a pointer to integer. In that case, set *LEN to + the byte length of the multibyte form. If ADVANCED is not NULL, is + must be a pointer to unsigned char. In that case, set *ADVANCED to + the ending address (i.e. the starting address of the next + character) of the multibyte form. */ + +int +string_char (p, advanced, len) + const unsigned char *p; + const unsigned char **advanced; + int *len; +{ + int c; + const unsigned char *saved_p = p; + + if (*p < 0x80 || ! (*p & 0x20) || ! (*p & 0x10)) + { + c = STRING_CHAR_ADVANCE (p); + } + else if (! (*p & 0x08)) + { + c = ((((p)[0] & 0xF) << 18) + | (((p)[1] & 0x3F) << 12) + | (((p)[2] & 0x3F) << 6) + | ((p)[3] & 0x3F)); + p += 4; + } + else + { + c = ((((p)[1] & 0x3F) << 18) + | (((p)[2] & 0x3F) << 12) + | (((p)[3] & 0x3F) << 6) + | ((p)[4] & 0x3F)); + p += 5; + } + + MAYBE_UNIFY_CHAR (c); + + if (len) + *len = p - saved_p; + if (advanced) + *advanced = p; + return c; +} + + +/* Translate character C by translation table TABLE. If C is + negative, translate a character specified by CHARSET and CODE. If + no translation is found in TABLE, return the untranslated + character. If TABLE is a list, elements are char tables. In this + case, translace C by all tables. */ + +int +translate_char (table, c) + Lisp_Object table; + int c; +{ + if (CHAR_TABLE_P (table)) + { + Lisp_Object ch; + + ch = CHAR_TABLE_REF (table, c); + if (CHARACTERP (ch)) + c = XINT (ch); + } + else + { + for (; CONSP (table); table = XCDR (table)) + c = translate_char (XCAR (table), c); + } + return c; +} + +/* Convert the multibyte character C to unibyte 8-bit character based + on the current value of charset_unibyte. If dimension of + charset_unibyte is more than one, return (C & 0xFF). + + The argument REV_TBL is now ignored. It will be removed in the + future. */ + +int +multibyte_char_to_unibyte (c, rev_tbl) + int c; + Lisp_Object rev_tbl; +{ + struct charset *charset; + unsigned c1; + + if (CHAR_BYTE8_P (c)) + return CHAR_TO_BYTE8 (c); + charset = CHARSET_FROM_ID (charset_unibyte); + c1 = ENCODE_CHAR (charset, c); + return ((c1 != CHARSET_INVALID_CODE (charset)) ? c1 : c & 0xFF); +} + +/* Like multibyte_char_to_unibyte, but return -1 if C is not supported + by charset_unibyte. */ + +int +multibyte_char_to_unibyte_safe (c) + int c; +{ + struct charset *charset; + unsigned c1; + + if (CHAR_BYTE8_P (c)) + return CHAR_TO_BYTE8 (c); + charset = CHARSET_FROM_ID (charset_unibyte); + c1 = ENCODE_CHAR (charset, c); + return ((c1 != CHARSET_INVALID_CODE (charset)) ? c1 : -1); +} + +DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0, + doc: /* Return non-nil if OBJECT is a character. */) + (object, ignore) + Lisp_Object object, ignore; +{ + return (CHARACTERP (object) ? Qt : Qnil); +} + +DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0, + doc: /* Return the character of the maximum code. */) + () +{ + return make_number (MAX_CHAR); +} + +DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte, + Sunibyte_char_to_multibyte, 1, 1, 0, + doc: /* Convert the unibyte character CH to multibyte character. +The multibyte character is a result of decoding CH by +the current unibyte charset (see `unibyte-charset'). */) + (ch) + Lisp_Object ch; +{ + int c; + struct charset *charset; + + CHECK_CHARACTER (ch); + c = XFASTINT (ch); + if (c >= 0400) + error ("Invalid unibyte character: %d", c); + charset = CHARSET_FROM_ID (charset_unibyte); + c = DECODE_CHAR (charset, c); + if (c < 0) + c = BYTE8_TO_CHAR (XFASTINT (ch)); + return make_number (c); +} + +DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte, + Smultibyte_char_to_unibyte, 1, 1, 0, + doc: /* Convert the multibyte character CH to unibyte character.\n\ +The unibyte character is a result of encoding CH by +the current primary charset (value of `charset-primary'). */) + (ch) + Lisp_Object ch; +{ + int c; + + CHECK_CHARACTER (ch); + c = XFASTINT (ch); + c = CHAR_TO_BYTE8 (c); + return make_number (c); +} + +DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0, + doc: /* Return 1 regardless of the argument CHAR. +This is now an obsolete function. We keep it just for backward compatibility. */) + (ch) + Lisp_Object ch; +{ + CHECK_CHARACTER (ch); + return make_number (1); +} + +DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0, + doc: /* Return width of CHAR when displayed in the current buffer. +The width is measured by how many columns it occupies on the screen. +Tab is taken to occupy `tab-width' columns. */) + (ch) + Lisp_Object ch; +{ + Lisp_Object disp; + int c, width; + struct Lisp_Char_Table *dp = buffer_display_table (); + + CHECK_CHARACTER (ch); + c = XINT (ch); + + /* Get the way the display table would display it. */ + disp = dp ? DISP_CHAR_VECTOR (dp, c) : Qnil; + + if (VECTORP (disp)) + width = ASIZE (disp); + else + width = CHAR_WIDTH (c); + + return make_number (width); +} + +/* Return width of string STR of length LEN when displayed in the + current buffer. The width is measured by how many columns it + occupies on the screen. If PRECISION > 0, return the width of + longest substring that doesn't exceed PRECISION, and set number of + characters and bytes of the substring in *NCHARS and *NBYTES + respectively. */ + +int +c_string_width (str, len, precision, nchars, nbytes) + const unsigned char *str; + int precision, *nchars, *nbytes; +{ + int i = 0, i_byte = 0; + int width = 0; + struct Lisp_Char_Table *dp = buffer_display_table (); + + while (i_byte < len) + { + int bytes, thiswidth; + Lisp_Object val; + int c = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes); + + if (dp) + { + val = DISP_CHAR_VECTOR (dp, c); + if (VECTORP (val)) + thiswidth = XVECTOR (val)->size; + else + thiswidth = CHAR_WIDTH (c); + } + else + { + thiswidth = CHAR_WIDTH (c); + } + + if (precision > 0 + && (width + thiswidth > precision)) + { + *nchars = i; + *nbytes = i_byte; + return width; + } + i++; + i_byte += bytes; + width += thiswidth; + } + + if (precision > 0) + { + *nchars = i; + *nbytes = i_byte; + } + + return width; +} + +/* Return width of string STR of length LEN when displayed in the + current buffer. The width is measured by how many columns it + occupies on the screen. */ + +int +strwidth (str, len) + unsigned char *str; + int len; +{ + return c_string_width (str, len, -1, NULL, NULL); +} + +/* Return width of Lisp string STRING when displayed in the current + buffer. The width is measured by how many columns it occupies on + the screen while paying attention to compositions. If PRECISION > + 0, return the width of longest substring that doesn't exceed + PRECISION, and set number of characters and bytes of the substring + in *NCHARS and *NBYTES respectively. */ + +int +lisp_string_width (string, precision, nchars, nbytes) + Lisp_Object string; + int precision, *nchars, *nbytes; +{ + int len = SCHARS (string); + /* This set multibyte to 0 even if STRING is multibyte when it + contains only ascii and eight-bit-graphic, but that's + intentional. */ + int multibyte = len < SBYTES (string); + unsigned char *str = SDATA (string); + int i = 0, i_byte = 0; + int width = 0; + struct Lisp_Char_Table *dp = buffer_display_table (); + + while (i < len) + { + int chars, bytes, thiswidth; + Lisp_Object val; + int cmp_id; + EMACS_INT ignore, end; + + if (find_composition (i, -1, &ignore, &end, &val, string) + && ((cmp_id = get_composition_id (i, i_byte, end - i, val, string)) + >= 0)) + { + thiswidth = composition_table[cmp_id]->width; + chars = end - i; + bytes = string_char_to_byte (string, end) - i_byte; + } + else + { + int c; + + if (multibyte) + c = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes); + else + c = str[i_byte], bytes = 1; + chars = 1; + if (dp) + { + val = DISP_CHAR_VECTOR (dp, c); + if (VECTORP (val)) + thiswidth = XVECTOR (val)->size; + else + thiswidth = CHAR_WIDTH (c); + } + else + { + thiswidth = CHAR_WIDTH (c); + } + } + + if (precision > 0 + && (width + thiswidth > precision)) + { + *nchars = i; + *nbytes = i_byte; + return width; + } + i += chars; + i_byte += bytes; + width += thiswidth; + } + + if (precision > 0) + { + *nchars = i; + *nbytes = i_byte; + } + + return width; +} + +DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0, + doc: /* Return width of STRING when displayed in the current buffer. +Width is measured by how many columns it occupies on the screen. +When calculating width of a multibyte character in STRING, +only the base leading-code is considered; the validity of +the following bytes is not checked. Tabs in STRING are always +taken to occupy `tab-width' columns. */) + (str) + Lisp_Object str; +{ + Lisp_Object val; + + CHECK_STRING (str); + XSETFASTINT (val, lisp_string_width (str, -1, NULL, NULL)); + return val; +} + +DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0, + doc: /* Return the direction of CHAR. +The returned value is 0 for left-to-right and 1 for right-to-left. */) + (ch) + Lisp_Object ch; +{ + int c; + + CHECK_CHARACTER (ch); + c = XINT (ch); + return CHAR_TABLE_REF (Vchar_direction_table, c); +} + +/* Return the number of characters in the NBYTES bytes at PTR. + This works by looking at the contents and checking for multibyte + sequences while assuming that there's no invalid sequence. + However, if the current buffer has enable-multibyte-characters = + nil, we treat each byte as a character. */ + +int +chars_in_text (ptr, nbytes) + const unsigned char *ptr; + int nbytes; +{ + /* current_buffer is null at early stages of Emacs initialization. */ + if (current_buffer == 0 + || NILP (current_buffer->enable_multibyte_characters)) + return nbytes; + + return multibyte_chars_in_text (ptr, nbytes); +} + +/* Return the number of characters in the NBYTES bytes at PTR. + This works by looking at the contents and checking for multibyte + sequences while assuming that there's no invalid sequence. It + ignores enable-multibyte-characters. */ + +int +multibyte_chars_in_text (ptr, nbytes) + const unsigned char *ptr; + int nbytes; +{ + const unsigned char *endp = ptr + nbytes; + int chars = 0; + + while (ptr < endp) + { + int len = MULTIBYTE_LENGTH (ptr, endp); + + if (len == 0) + abort (); + ptr += len; + chars++; + } + + return chars; +} + +/* Parse unibyte text at STR of LEN bytes as a multibyte text, count + characters and bytes in it, and store them in *NCHARS and *NBYTES + respectively. On counting bytes, pay attention to that 8-bit + characters not constructing a valid multibyte sequence are + represented by 2-byte in a multibyte text. */ + +void +parse_str_as_multibyte (str, len, nchars, nbytes) + const unsigned char *str; + int len, *nchars, *nbytes; +{ + const unsigned char *endp = str + len; + int n, chars = 0, bytes = 0; + + if (len >= MAX_MULTIBYTE_LENGTH) + { + const unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH; + while (str < adjusted_endp) + { + if ((n = MULTIBYTE_LENGTH_NO_CHECK (str)) > 0) + str += n, bytes += n; + else + str++, bytes += 2; + chars++; + } + } + while (str < endp) + { + if ((n = MULTIBYTE_LENGTH (str, endp)) > 0) + str += n, bytes += n; + else + str++, bytes += 2; + chars++; + } + + *nchars = chars; + *nbytes = bytes; + return; +} + +/* Arrange unibyte text at STR of NBYTES bytes as a multibyte text. + It actually converts only such 8-bit characters that don't contruct + a multibyte sequence to multibyte forms of Latin-1 characters. If + NCHARS is nonzero, set *NCHARS to the number of characters in the + text. It is assured that we can use LEN bytes at STR as a work + area and that is enough. Return the number of bytes of the + resulting text. */ + +int +str_as_multibyte (str, len, nbytes, nchars) + unsigned char *str; + int len, nbytes, *nchars; +{ + unsigned char *p = str, *endp = str + nbytes; + unsigned char *to; + int chars = 0; + int n; + + if (nbytes >= MAX_MULTIBYTE_LENGTH) + { + unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH; + while (p < adjusted_endp + && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0) + p += n, chars++; + } + while ((n = MULTIBYTE_LENGTH (p, endp)) > 0) + p += n, chars++; + if (nchars) + *nchars = chars; + if (p == endp) + return nbytes; + + to = p; + nbytes = endp - p; + endp = str + len; + safe_bcopy ((char *) p, (char *) (endp - nbytes), nbytes); + p = endp - nbytes; + + if (nbytes >= MAX_MULTIBYTE_LENGTH) + { + unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH; + while (p < adjusted_endp) + { + if ((n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0) + { + while (n--) + *to++ = *p++; + } + else + { + int c = *p++; + c = BYTE8_TO_CHAR (c); + to += CHAR_STRING (c, to); + } + } + chars++; + } + while (p < endp) + { + if ((n = MULTIBYTE_LENGTH (p, endp)) > 0) + { + while (n--) + *to++ = *p++; + } + else + { + int c = *p++; + c = BYTE8_TO_CHAR (c); + to += CHAR_STRING (c, to); + } + chars++; + } + if (nchars) + *nchars = chars; + return (to - str); +} + +/* Parse unibyte string at STR of LEN bytes, and return the number of + bytes it may ocupy when converted to multibyte string by + `str_to_multibyte'. */ + +int +parse_str_to_multibyte (str, len) + unsigned char *str; + int len; +{ + unsigned char *endp = str + len; + int bytes; + + for (bytes = 0; str < endp; str++) + bytes += (*str < 0x80) ? 1 : 2; + return bytes; +} + + +/* Convert unibyte text at STR of NBYTES bytes to a multibyte text + that contains the same single-byte characters. It actually + converts all 8-bit characters to multibyte forms. It is assured + that we can use LEN bytes at STR as a work area and that is + enough. */ + +int +str_to_multibyte (str, len, bytes) + unsigned char *str; + int len, bytes; +{ + unsigned char *p = str, *endp = str + bytes; + unsigned char *to; + + while (p < endp && *p < 0x80) p++; + if (p == endp) + return bytes; + to = p; + bytes = endp - p; + endp = str + len; + safe_bcopy ((char *) p, (char *) (endp - bytes), bytes); + p = endp - bytes; + while (p < endp) + { + int c = *p++; + + if (c >= 0x80) + c = BYTE8_TO_CHAR (c); + to += CHAR_STRING (c, to); + } + return (to - str); +} + +/* Arrange multibyte text at STR of LEN bytes as a unibyte text. It + actually converts characters in the range 0x80..0xFF to + unibyte. */ + +int +str_as_unibyte (str, bytes) + unsigned char *str; + int bytes; +{ + const unsigned char *p = str, *endp = str + bytes; + unsigned char *to; + int c, len; + + while (p < endp) + { + c = *p; + len = BYTES_BY_CHAR_HEAD (c); + if (CHAR_BYTE8_HEAD_P (c)) + break; + p += len; + } + to = str + (p - str); + while (p < endp) + { + c = *p; + len = BYTES_BY_CHAR_HEAD (c); + if (CHAR_BYTE8_HEAD_P (c)) + { + c = STRING_CHAR_ADVANCE (p); + *to++ = CHAR_TO_BYTE8 (c); + } + else + { + while (len--) *to++ = *p++; + } + } + return (to - str); +} + +int +string_count_byte8 (string) + Lisp_Object string; +{ + int multibyte = STRING_MULTIBYTE (string); + int nbytes = SBYTES (string); + unsigned char *p = SDATA (string); + unsigned char *pend = p + nbytes; + int count = 0; + int c, len; + + if (multibyte) + while (p < pend) + { + c = *p; + len = BYTES_BY_CHAR_HEAD (c); + + if (CHAR_BYTE8_HEAD_P (c)) + count++; + p += len; + } + else + while (p < pend) + { + if (*p++ >= 0x80) + count++; + } + return count; +} + + +Lisp_Object +string_escape_byte8 (string) + Lisp_Object string; +{ + int nchars = SCHARS (string); + int nbytes = SBYTES (string); + int multibyte = STRING_MULTIBYTE (string); + int byte8_count; + const unsigned char *src, *src_end; + unsigned char *dst; + Lisp_Object val; + int c, len; + + if (multibyte && nchars == nbytes) + return string; + + byte8_count = string_count_byte8 (string); + + if (byte8_count == 0) + return string; + + if (multibyte) + /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */ + val = make_uninit_multibyte_string (nchars + byte8_count * 3, + nbytes + byte8_count * 2); + else + /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */ + val = make_uninit_string (nbytes + byte8_count * 3); + + src = SDATA (string); + src_end = src + nbytes; + dst = SDATA (val); + if (multibyte) + while (src < src_end) + { + c = *src; + len = BYTES_BY_CHAR_HEAD (c); + + if (CHAR_BYTE8_HEAD_P (c)) + { + c = STRING_CHAR_ADVANCE (src); + c = CHAR_TO_BYTE8 (c); + sprintf ((char *) dst, "\\%03o", c); + dst += 4; + } + else + while (len--) *dst++ = *src++; + } + else + while (src < src_end) + { + c = *src++; + if (c >= 0x80) + { + sprintf ((char *) dst, "\\%03o", c); + dst += 4; + } + else + *dst++ = c; + } + return val; +} + + +DEFUN ("string", Fstring, Sstring, 0, MANY, 0, + doc: /* +Concatenate all the argument characters and make the result a string. +usage: (string &rest CHARACTERS) */) + (n, args) + int n; + Lisp_Object *args; +{ + int i; + unsigned char *buf = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH * n); + unsigned char *p = buf; + int c; + + for (i = 0; i < n; i++) + { + CHECK_CHARACTER (args[i]); + c = XINT (args[i]); + p += CHAR_STRING (c, p); + } + + return make_string_from_bytes ((char *) buf, n, p - buf); +} + +DEFUN ("unibyte-string", Funibyte_string, Sunibyte_string, 0, MANY, 0, + doc: /* Concatenate all the argument bytes and make the result a unibyte string. +usage: (unibyte-string &rest BYTES) */) + (n, args) + int n; + Lisp_Object *args; +{ + int i; + unsigned char *buf = (unsigned char *) alloca (n); + unsigned char *p = buf; + unsigned c; + + for (i = 0; i < n; i++) + { + CHECK_NATNUM (args[i]); + c = XFASTINT (args[i]); + if (c >= 256) + args_out_of_range_3 (args[i], make_number (0), make_number (255)); + *p++ = c; + } + + return make_string_from_bytes ((char *) buf, n, p - buf); +} + +void +init_character_once () +{ +} + +#ifdef emacs + +void +syms_of_character () +{ + DEFSYM (Qcharacterp, "characterp"); + DEFSYM (Qauto_fill_chars, "auto-fill-chars"); + + staticpro (&Vchar_unify_table); + Vchar_unify_table = Qnil; + + defsubr (&Smax_char); + defsubr (&Scharacterp); + defsubr (&Sunibyte_char_to_multibyte); + defsubr (&Smultibyte_char_to_unibyte); + defsubr (&Schar_bytes); + defsubr (&Schar_width); + defsubr (&Sstring_width); + defsubr (&Schar_direction); + defsubr (&Sstring); + defsubr (&Sunibyte_string); + + DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector, + doc: /* +Vector recording all translation tables ever defined. +Each element is a pair (SYMBOL . TABLE) relating the table to the +symbol naming it. The ID of a translation table is an index into this vector. */); + Vtranslation_table_vector = Fmake_vector (make_number (16), Qnil); + + DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars, + doc: /* +A char-table for characters which invoke auto-filling. +Such characters have value t in this table. */); + Vauto_fill_chars = Fmake_char_table (Qauto_fill_chars, Qnil); + CHAR_TABLE_SET (Vauto_fill_chars, ' ', Qt); + CHAR_TABLE_SET (Vauto_fill_chars, '\n', Qt); + + DEFVAR_LISP ("char-width-table", &Vchar_width_table, + doc: /* +A char-table for width (columns) of each character. */); + Vchar_width_table = Fmake_char_table (Qnil, make_number (1)); + char_table_set_range (Vchar_width_table, 0x80, 0x9F, make_number (4)); + char_table_set_range (Vchar_width_table, MAX_5_BYTE_CHAR + 1, MAX_CHAR, + make_number (4)); + + DEFVAR_LISP ("char-direction-table", &Vchar_direction_table, + doc: /* A char-table for direction of each character. */); + Vchar_direction_table = Fmake_char_table (Qnil, make_number (1)); + + DEFVAR_LISP ("printable-chars", &Vprintable_chars, + doc: /* A char-table for each printable character. */); + Vprintable_chars = Fmake_char_table (Qnil, Qnil); + Fset_char_table_range (Vprintable_chars, + Fcons (make_number (32), make_number (126)), Qt); + Fset_char_table_range (Vprintable_chars, + Fcons (make_number (160), + make_number (MAX_5_BYTE_CHAR)), Qt); + + DEFVAR_LISP ("char-script-table", &Vchar_script_table, + doc: /* Char table of script symbols. +It has one extra slot whose value is a list of script symbols. */); + + /* Intern this now in case it isn't already done. + Setting this variable twice is harmless. + But don't staticpro it here--that is done in alloc.c. */ + Qchar_table_extra_slots = intern ("char-table-extra-slots"); + DEFSYM (Qchar_script_table, "char-script-table"); + Fput (Qchar_script_table, Qchar_table_extra_slots, make_number (1)); + Vchar_script_table = Fmake_char_table (Qchar_script_table, Qnil); + + DEFVAR_LISP ("script-representative-chars", &Vscript_representative_chars, + doc: /* Alist of scripts vs the representative characters. */); + Vscript_representative_chars = Qnil; +} + +#endif /* emacs */ + +/* arch-tag: b6665960-3c3d-4184-85cd-af4318197999 + (do not change this comment) */ diff --git a/src/character.h b/src/character.h new file mode 100644 index 00000000000..1e4a120e035 --- /dev/null +++ b/src/character.h @@ -0,0 +1,667 @@ +/* Header for multibyte character handler. + Copyright (C) 1995, 1997, 1998 Electrotechnical Laboratory, JAPAN. + Licensed to the Free Software Foundation. + Copyright (C) 2003, 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#ifndef EMACS_CHARACTER_H +#define EMACS_CHARACTER_H + +/* character code 1st byte byte sequence + -------------- -------- ------------- + 0-7F 00..7F 0xxxxxxx + 80-7FF C2..DF 110xxxxx 10xxxxxx + 800-FFFF E0..EF 1110xxxx 10xxxxxx 10xxxxxx + 10000-1FFFFF F0..F7 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx + 200000-3FFF7F F8 11111000 1000xxxx 10xxxxxx 10xxxxxx 10xxxxxx + 3FFF80-3FFFFF C0..C1 1100000x 10xxxxxx (for eight-bit-char) + 400000-... invalid + + invalid 1st byte 80..BF 10xxxxxx + F9..FF 11111xxx (xxx != 000) +*/ + +/* Maximum character code ((1 << CHARACTERBITS) - 1). */ +#define MAX_CHAR 0x3FFFFF + +/* Maximum Unicode character code. */ +#define MAX_UNICODE_CHAR 0x10FFFF + +/* Maximum N-byte character codes. */ +#define MAX_1_BYTE_CHAR 0x7F +#define MAX_2_BYTE_CHAR 0x7FF +#define MAX_3_BYTE_CHAR 0xFFFF +#define MAX_4_BYTE_CHAR 0x1FFFFF +#define MAX_5_BYTE_CHAR 0x3FFF7F + +/* Minimum leading code of multibyte characters. */ +#define MIN_MULTIBYTE_LEADING_CODE 0xC0 +/* Maximum leading code of multibyte characters. */ +#define MAX_MULTIBYTE_LEADING_CODE 0xF8 + +/* Nonzero iff C is a character that corresponds to a raw 8-bit + byte. */ +#define CHAR_BYTE8_P(c) ((c) > MAX_5_BYTE_CHAR) + +/* Return the character code for raw 8-bit byte BYTE. */ +#define BYTE8_TO_CHAR(byte) ((byte) + 0x3FFF00) + +/* Return the raw 8-bit byte for character C. */ +#define CHAR_TO_BYTE8(c) \ + (CHAR_BYTE8_P (c) \ + ? (c) - 0x3FFF00 \ + : multibyte_char_to_unibyte (c, Qnil)) + +/* Nonzero iff BYTE is the 1st byte of a multibyte form of a character + that corresponds to a raw 8-bit byte. */ +#define CHAR_BYTE8_HEAD_P(byte) ((byte) == 0xC0 || (byte) == 0xC1) + +/* Mapping table from unibyte chars to multibyte chars. */ +extern int unibyte_to_multibyte_table[256]; + +/* Convert the unibyte character C to the corresponding multibyte + character. If C can't be converted, return C. */ +#define unibyte_char_to_multibyte(c) \ + ((c) < 256 ? unibyte_to_multibyte_table[(c)] : (c)) + +/* Nth element is 1 iff unibyte char N can be mapped to a multibyte + char. */ +extern char unibyte_has_multibyte_table[256]; + +#define UNIBYTE_CHAR_HAS_MULTIBYTE_P(c) (unibyte_has_multibyte_table[(c)]) + +/* If C is not ASCII, make it unibyte. */ +#define MAKE_CHAR_UNIBYTE(c) \ + do { \ + if (! ASCII_CHAR_P (c)) \ + c = CHAR_TO_BYTE8 (c); \ + } while (0) + + +/* If C is not ASCII, make it multibyte. It assumes C < 256. */ +#define MAKE_CHAR_MULTIBYTE(c) ((c) = unibyte_to_multibyte_table[(c)]) + +/* This is the maximum byte length of multibyte form. */ +#define MAX_MULTIBYTE_LENGTH 5 + +/* Return a Lisp character whose character code is C. It assumes C is + a valid character code. */ +#define make_char(c) make_number (c) + +/* Nonzero iff C is an ASCII byte. */ +#define ASCII_BYTE_P(c) ((unsigned) (c) < 0x80) + +/* Nonzero iff X is a character. */ +#define CHARACTERP(x) (NATNUMP (x) && XFASTINT (x) <= MAX_CHAR) + +/* Nonzero iff C is valid as a character code. GENERICP is not used + now. */ +#define CHAR_VALID_P(c, genericp) ((unsigned) (c) <= MAX_CHAR) + +/* Check if Lisp object X is a character or not. */ +#define CHECK_CHARACTER(x) \ + CHECK_TYPE (CHARACTERP (x), Qcharacterp, x) + +#define CHECK_CHARACTER_CAR(x) \ + do { \ + Lisp_Object tmp = XCAR (x); \ + CHECK_CHARACTER (tmp); \ + XSETCAR ((x), tmp); \ + } while (0) + +#define CHECK_CHARACTER_CDR(x) \ + do { \ + Lisp_Object tmp = XCDR (x); \ + CHECK_CHARACTER (tmp); \ + XSETCDR ((x), tmp); \ + } while (0) + +/* Nonzero iff C is an ASCII character. */ +#define ASCII_CHAR_P(c) ((unsigned) (c) < 0x80) + +/* Nonzero iff C is a character of code less than 0x100. */ +#define SINGLE_BYTE_CHAR_P(c) ((unsigned) (c) < 0x100) + +/* Nonzero if character C has a printable glyph. */ +#define CHAR_PRINTABLE_P(c) \ + (((c) >= 32 && ((c) < 127) \ + || ! NILP (CHAR_TABLE_REF (Vprintable_chars, (c))))) + +/* Return byte length of multibyte form for character C. */ +#define CHAR_BYTES(c) \ + ( (c) <= MAX_1_BYTE_CHAR ? 1 \ + : (c) <= MAX_2_BYTE_CHAR ? 2 \ + : (c) <= MAX_3_BYTE_CHAR ? 3 \ + : (c) <= MAX_4_BYTE_CHAR ? 4 \ + : (c) <= MAX_5_BYTE_CHAR ? 5 \ + : 2) + + +/* Return the leading code of multibyte form of C. */ +#define CHAR_LEADING_CODE(c) \ + ((c) <= MAX_1_BYTE_CHAR ? c \ + : (c) <= MAX_2_BYTE_CHAR ? (0xC0 | ((c) >> 6)) \ + : (c) <= MAX_3_BYTE_CHAR ? (0xE0 | ((c) >> 12)) \ + : (c) <= MAX_4_BYTE_CHAR ? (0xF0 | ((c) >> 18)) \ + : (c) <= MAX_5_BYTE_CHAR ? 0xF8 \ + : (0xC0 | (((c) >> 6) & 0x01))) + + +/* Store multibyte form of the character C in P. The caller should + allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance. + Returns the length of the multibyte form. */ + +#define CHAR_STRING(c, p) \ + ((unsigned) (c) <= MAX_1_BYTE_CHAR \ + ? ((p)[0] = (c), \ + 1) \ + : (unsigned) (c) <= MAX_2_BYTE_CHAR \ + ? ((p)[0] = (0xC0 | ((c) >> 6)), \ + (p)[1] = (0x80 | ((c) & 0x3F)), \ + 2) \ + : (unsigned) (c) <= MAX_3_BYTE_CHAR \ + ? ((p)[0] = (0xE0 | ((c) >> 12)), \ + (p)[1] = (0x80 | (((c) >> 6) & 0x3F)), \ + (p)[2] = (0x80 | ((c) & 0x3F)), \ + 3) \ + : char_string ((unsigned) c, p)) + +/* Store multibyte form of byte B in P. The caller should allocate at + least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the + length of the multibyte form. */ + +#define BYTE8_STRING(b, p) \ + ((p)[0] = (0xC0 | (((b) >> 6) & 0x01)), \ + (p)[1] = (0x80 | ((b) & 0x3F)), \ + 2) + + +/* Store multibyte form of the character C in P. The caller should + allocate at least MAX_MULTIBYTE_LENGTH bytes area at P in advance. + And, advance P to the end of the multibyte form. */ + +#define CHAR_STRING_ADVANCE(c, p) \ + do { \ + if ((c) <= MAX_1_BYTE_CHAR) \ + *(p)++ = (c); \ + else if ((c) <= MAX_2_BYTE_CHAR) \ + *(p)++ = (0xC0 | ((c) >> 6)), \ + *(p)++ = (0x80 | ((c) & 0x3F)); \ + else if ((c) <= MAX_3_BYTE_CHAR) \ + *(p)++ = (0xE0 | ((c) >> 12)), \ + *(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \ + *(p)++ = (0x80 | ((c) & 0x3F)); \ + else \ + (p) += char_string ((c), (p)); \ + } while (0) + + +/* Nonzero iff BYTE starts a non-ASCII character in a multibyte + form. */ +#define LEADING_CODE_P(byte) (((byte) & 0xC0) == 0xC0) + +/* Nonzero iff BYTE is a trailing code of a non-ASCII character in a + multibyte form. */ +#define TRAILING_CODE_P(byte) (((byte) & 0xC0) == 0x80) + +/* Nonzero iff BYTE starts a character in a multibyte form. + This is equivalent to: + (ASCII_BYTE_P (byte) || LEADING_CODE_P (byte)) */ +#define CHAR_HEAD_P(byte) (((byte) & 0xC0) != 0x80) + +/* Just kept for backward compatibility. This macro will be removed + in the future. */ +#define BASE_LEADING_CODE_P LEADING_CODE_P + +/* How many bytes a character that starts with BYTE occupies in a + multibyte form. */ +#define BYTES_BY_CHAR_HEAD(byte) \ + (!((byte) & 0x80) ? 1 \ + : !((byte) & 0x20) ? 2 \ + : !((byte) & 0x10) ? 3 \ + : !((byte) & 0x08) ? 4 \ + : 5) + + +/* Return the length of the multi-byte form at string STR of length + LEN while assuming that STR points a valid multi-byte form. As + this macro isn't necessary anymore, all callers will be changed to + use BYTES_BY_CHAR_HEAD directly in the future. */ + +#define MULTIBYTE_FORM_LENGTH(str, len) \ + BYTES_BY_CHAR_HEAD (*(str)) + +/* Parse multibyte string STR of length LENGTH and set BYTES to the + byte length of a character at STR while assuming that STR points a + valid multibyte form. As this macro isn't necessary anymore, all + callers will be changed to use BYTES_BY_CHAR_HEAD directly in the + future. */ + +#define PARSE_MULTIBYTE_SEQ(str, length, bytes) \ + (bytes) = BYTES_BY_CHAR_HEAD (*(str)) + +/* The byte length of multibyte form at unibyte string P ending at + PEND. If STR doesn't point a valid multibyte form, return 0. */ + +#define MULTIBYTE_LENGTH(p, pend) \ + (p >= pend ? 0 \ + : !((p)[0] & 0x80) ? 1 \ + : ((p + 1 >= pend) || (((p)[1] & 0xC0) != 0x80)) ? 0 \ + : ((p)[0] & 0xE0) == 0xC0 ? 2 \ + : ((p + 2 >= pend) || (((p)[2] & 0xC0) != 0x80)) ? 0 \ + : ((p)[0] & 0xF0) == 0xE0 ? 3 \ + : ((p + 3 >= pend) || (((p)[3] & 0xC0) != 0x80)) ? 0 \ + : ((p)[0] & 0xF8) == 0xF0 ? 4 \ + : ((p + 4 >= pend) || (((p)[4] & 0xC0) != 0x80)) ? 0 \ + : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \ + : 0) + + +/* Like MULTIBYTE_LENGTH but don't check the ending address. */ + +#define MULTIBYTE_LENGTH_NO_CHECK(p) \ + (!((p)[0] & 0x80) ? 1 \ + : ((p)[1] & 0xC0) != 0x80 ? 0 \ + : ((p)[0] & 0xE0) == 0xC0 ? 2 \ + : ((p)[2] & 0xC0) != 0x80 ? 0 \ + : ((p)[0] & 0xF0) == 0xE0 ? 3 \ + : ((p)[3] & 0xC0) != 0x80 ? 0 \ + : ((p)[0] & 0xF8) == 0xF0 ? 4 \ + : ((p)[4] & 0xC0) != 0x80 ? 0 \ + : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \ + : 0) + +/* If P is before LIMIT, advance P to the next character boundary. It + assumes that P is already at a character boundary of the sane + mulitbyte form whose end address is LIMIT. */ + +#define NEXT_CHAR_BOUNDARY(p, limit) \ + do { \ + if ((p) < (limit)) \ + (p) += BYTES_BY_CHAR_HEAD (*(p)); \ + } while (0) + + +/* If P is after LIMIT, advance P to the previous character boundary. + It assumes that P is already at a character boundary of the sane + mulitbyte form whose beginning address is LIMIT. */ + +#define PREV_CHAR_BOUNDARY(p, limit) \ + do { \ + if ((p) > (limit)) \ + { \ + const unsigned char *p0 = (p); \ + do { \ + p0--; \ + } while (p0 >= limit && ! CHAR_HEAD_P (*p0)); \ + (p) = (BYTES_BY_CHAR_HEAD (*p0) == (p) - p0) ? p0 : (p) - 1; \ + } \ + } while (0) + +/* Return the character code of character whose multibyte form is at + P. The argument LEN is ignored. It will be removed in the + future. */ + +#define STRING_CHAR(p, len) \ + (!((p)[0] & 0x80) \ + ? (p)[0] \ + : ! ((p)[0] & 0x20) \ + ? (((((p)[0] & 0x1F) << 6) \ + | ((p)[1] & 0x3F)) \ + + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0)) \ + : ! ((p)[0] & 0x10) \ + ? ((((p)[0] & 0x0F) << 12) \ + | (((p)[1] & 0x3F) << 6) \ + | ((p)[2] & 0x3F)) \ + : string_char ((p), NULL, NULL)) + + +/* Like STRING_CHAR but set ACTUAL_LEN to the length of multibyte + form. The argument LEN is ignored. It will be removed in the + future. */ + +#define STRING_CHAR_AND_LENGTH(p, len, actual_len) \ + (!((p)[0] & 0x80) \ + ? ((actual_len) = 1, (p)[0]) \ + : ! ((p)[0] & 0x20) \ + ? ((actual_len) = 2, \ + (((((p)[0] & 0x1F) << 6) \ + | ((p)[1] & 0x3F)) \ + + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0))) \ + : ! ((p)[0] & 0x10) \ + ? ((actual_len) = 3, \ + ((((p)[0] & 0x0F) << 12) \ + | (((p)[1] & 0x3F) << 6) \ + | ((p)[2] & 0x3F))) \ + : string_char ((p), NULL, &actual_len)) + + +/* Like STRING_CHAR but advance P to the end of multibyte form. */ + +#define STRING_CHAR_ADVANCE(p) \ + (!((p)[0] & 0x80) \ + ? *(p)++ \ + : ! ((p)[0] & 0x20) \ + ? ((p) += 2, \ + ((((p)[-2] & 0x1F) << 6) \ + | ((p)[-1] & 0x3F) \ + | ((unsigned char) ((p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \ + : ! ((p)[0] & 0x10) \ + ? ((p) += 3, \ + ((((p)[-3] & 0x0F) << 12) \ + | (((p)[-2] & 0x3F) << 6) \ + | ((p)[-1] & 0x3F))) \ + : string_char ((p), &(p), NULL)) + + +/* Fetch the "next" character from Lisp string STRING at byte position + BYTEIDX, character position CHARIDX. Store it into OUTPUT. + + All the args must be side-effect-free. + BYTEIDX and CHARIDX must be lvalues; + we increment them past the character fetched. */ + +#define FETCH_STRING_CHAR_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \ + if (1) \ + { \ + CHARIDX++; \ + if (STRING_MULTIBYTE (STRING)) \ + { \ + unsigned char *ptr = &XSTRING (STRING)->data[BYTEIDX]; \ + int len; \ + \ + OUTPUT = STRING_CHAR_AND_LENGTH (ptr, 0, len); \ + BYTEIDX += len; \ + } \ + else \ + OUTPUT = XSTRING (STRING)->data[BYTEIDX++]; \ + } \ + else + +/* Like FETCH_STRING_CHAR_ADVANCE but return a multibyte character eve + if STRING is unibyte. */ + +#define FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \ + if (1) \ + { \ + CHARIDX++; \ + if (STRING_MULTIBYTE (STRING)) \ + { \ + unsigned char *ptr = &XSTRING (STRING)->data[BYTEIDX]; \ + int len; \ + \ + OUTPUT = STRING_CHAR_AND_LENGTH (ptr, 0, len); \ + BYTEIDX += len; \ + } \ + else \ + { \ + OUTPUT = XSTRING (STRING)->data[BYTEIDX++]; \ + MAKE_CHAR_MULTIBYTE (OUTPUT); \ + } \ + } \ + else + + +/* Like FETCH_STRING_CHAR_ADVANCE but assumes STRING is multibyte. */ + +#define FETCH_STRING_CHAR_ADVANCE_NO_CHECK(OUTPUT, STRING, CHARIDX, BYTEIDX) \ + if (1) \ + { \ + unsigned char *ptr = &XSTRING (STRING)->data[BYTEIDX]; \ + int len; \ + \ + OUTPUT = STRING_CHAR_AND_LENGTH (ptr, 0, len); \ + BYTEIDX += len; \ + CHARIDX++; \ + } \ + else + + +/* Like FETCH_STRING_CHAR_ADVANCE but fetch character from the current + buffer. */ + +#define FETCH_CHAR_ADVANCE(OUTPUT, CHARIDX, BYTEIDX) \ + if (1) \ + { \ + CHARIDX++; \ + if (!NILP (current_buffer->enable_multibyte_characters)) \ + { \ + unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \ + int len; \ + \ + OUTPUT= STRING_CHAR_AND_LENGTH (ptr, 0, len); \ + BYTEIDX += len; \ + } \ + else \ + { \ + OUTPUT = *(BYTE_POS_ADDR (BYTEIDX)); \ + BYTEIDX++; \ + } \ + } \ + else + + +/* Like FETCH_CHAR_ADVANCE but assumes the current buffer is multibyte. */ + +#define FETCH_CHAR_ADVANCE_NO_CHECK(OUTPUT, CHARIDX, BYTEIDX) \ + if (1) \ + { \ + unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \ + int len; \ + \ + OUTPUT= STRING_CHAR_AND_LENGTH (ptr, 0, len); \ + BYTEIDX += len; \ + CHARIDX++; \ + } \ + else + + +/* Increase the buffer byte position POS_BYTE of the current buffer to + the next character boundary. No range checking of POS. */ + +#define INC_POS(pos_byte) \ + do { \ + unsigned char *p = BYTE_POS_ADDR (pos_byte); \ + pos_byte += BYTES_BY_CHAR_HEAD (*p); \ + } while (0) + + +/* Decrease the buffer byte position POS_BYTE of the current buffer to + the previous character boundary. No range checking of POS. */ + +#define DEC_POS(pos_byte) \ + do { \ + unsigned char *p; \ + \ + pos_byte--; \ + if (pos_byte < GPT_BYTE) \ + p = BEG_ADDR + pos_byte - 1; \ + else \ + p = BEG_ADDR + GAP_SIZE + pos_byte - 1; \ + while (!CHAR_HEAD_P (*p)) \ + { \ + p--; \ + pos_byte--; \ + } \ + } while (0) + +/* Increment both CHARPOS and BYTEPOS, each in the appropriate way. */ + +#define INC_BOTH(charpos, bytepos) \ + do \ + { \ + (charpos)++; \ + if (NILP (current_buffer->enable_multibyte_characters)) \ + (bytepos)++; \ + else \ + INC_POS ((bytepos)); \ + } \ + while (0) + + +/* Decrement both CHARPOS and BYTEPOS, each in the appropriate way. */ + +#define DEC_BOTH(charpos, bytepos) \ + do \ + { \ + (charpos)--; \ + if (NILP (current_buffer->enable_multibyte_characters)) \ + (bytepos)--; \ + else \ + DEC_POS ((bytepos)); \ + } \ + while (0) + + +/* Increase the buffer byte position POS_BYTE of the current buffer to + the next character boundary. This macro relies on the fact that + *GPT_ADDR and *Z_ADDR are always accessible and the values are + '\0'. No range checking of POS_BYTE. */ + +#define BUF_INC_POS(buf, pos_byte) \ + do { \ + unsigned char *p = BUF_BYTE_ADDRESS (buf, pos_byte); \ + pos_byte += BYTES_BY_CHAR_HEAD (*p); \ + } while (0) + + +/* Decrease the buffer byte position POS_BYTE of the current buffer to + the previous character boundary. No range checking of POS_BYTE. */ + +#define BUF_DEC_POS(buf, pos_byte) \ + do { \ + unsigned char *p; \ + pos_byte--; \ + if (pos_byte < BUF_GPT_BYTE (buf)) \ + p = BUF_BEG_ADDR (buf) + pos_byte - 1; \ + else \ + p = BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + pos_byte - 1; \ + while (!CHAR_HEAD_P (*p)) \ + { \ + p--; \ + pos_byte--; \ + } \ + } while (0) + + +/* If C is a character to be unified with a Unicode character, return + the unified Unicode character. */ + +#define MAYBE_UNIFY_CHAR(c) \ + if (c > MAX_UNICODE_CHAR \ + && CHAR_TABLE_P (Vchar_unify_table)) \ + { \ + Lisp_Object val; \ + int unified; \ + \ + val = CHAR_TABLE_REF (Vchar_unify_table, c); \ + if (! NILP (val)) \ + { \ + if (SYMBOLP (val)) \ + { \ + Funify_charset (val, Qnil, Qnil); \ + val = CHAR_TABLE_REF (Vchar_unify_table, c); \ + } \ + if ((unified = XINT (val)) >= 0) \ + c = unified; \ + } \ + } \ + else + + +/* Return the width of ASCII character C. The width is measured by + how many columns occupied on the screen when displayed in the + current buffer. */ + +#define ASCII_CHAR_WIDTH(c) \ + (c < 0x20 \ + ? (c == '\t' \ + ? XFASTINT (current_buffer->tab_width) \ + : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \ + : (c < 0x7f \ + ? 1 \ + : ((NILP (current_buffer->ctl_arrow) ? 4 : 2)))) + +/* Return the width of character C. The width is measured by how many + columns occupied on the screen when displayed in the current + buffer. */ + +#define CHAR_WIDTH(c) \ + (ASCII_CHAR_P (c) \ + ? ASCII_CHAR_WIDTH (c) \ + : XINT (CHAR_TABLE_REF (Vchar_width_table, c))) + +extern int char_resolve_modifier_mask P_ ((int)); +extern int char_string P_ ((unsigned, unsigned char *)); +extern int string_char P_ ((const unsigned char *, + const unsigned char **, int *)); + +extern int translate_char P_ ((Lisp_Object, int c)); +extern int char_printable_p P_ ((int c)); +extern void parse_str_as_multibyte P_ ((const unsigned char *, int, int *, + int *)); +extern int parse_str_to_multibyte P_ ((unsigned char *, int)); +extern int str_as_multibyte P_ ((unsigned char *, int, int, int *)); +extern int str_to_multibyte P_ ((unsigned char *, int, int)); +extern int str_as_unibyte P_ ((unsigned char *, int)); +extern int strwidth P_ ((unsigned char *, int)); +extern int c_string_width P_ ((const unsigned char *, int, int, int *, int *)); +extern int lisp_string_width P_ ((Lisp_Object, int, int *, int *)); + +extern Lisp_Object Vprintable_chars; + +extern Lisp_Object Qcharacterp, Qauto_fill_chars; +extern Lisp_Object Vtranslation_table_vector; +extern Lisp_Object Vchar_width_table; +extern Lisp_Object Vchar_direction_table; +extern Lisp_Object Vchar_unify_table; + +extern Lisp_Object string_escape_byte8 P_ ((Lisp_Object)); + +/* Return a translation table of id number ID. */ +#define GET_TRANSLATION_TABLE(id) \ + (XCDR(XVECTOR(Vtranslation_table_vector)->contents[(id)])) + +/* A char-table for characters which may invoke auto-filling. */ +extern Lisp_Object Vauto_fill_chars; + +extern Lisp_Object Vchar_script_table; +extern Lisp_Object Vscript_representative_chars; + +/* Copy LEN bytes from FROM to TO. This macro should be used only + when a caller knows that LEN is short and the obvious copy loop is + faster than calling bcopy which has some overhead. Copying a + multibyte sequence of a character is the typical case. */ + +#define BCOPY_SHORT(from, to, len) \ + do { \ + int i = len; \ + unsigned char *from_p = from, *to_p = to; \ + while (i--) *to_p++ = *from_p++; \ + } while (0) + +#define DEFSYM(sym, name) \ + do { (sym) = intern ((name)); staticpro (&(sym)); } while (0) + +#endif /* EMACS_CHARACTER_H */ + +/* arch-tag: 4ef86004-2eff-4073-8cea-cfcbcf7188ac + (do not change this comment) */ diff --git a/src/charset.c b/src/charset.c index 1a85cd39c72..9ed6a733223 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1,4 +1,4 @@ -/* Basic multilingual character support. +/* Basic character set support. Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -6,6 +6,10 @@ National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003, 2004 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify @@ -23,720 +27,1248 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ -/* At first, see the document in `charset.h' to understand the code in - this file. */ - -#ifdef emacs #include <config.h> -#endif #include <stdio.h> - -#ifdef emacs - +#include <unistd.h> +#include <ctype.h> #include <sys/types.h> #include "lisp.h" -#include "buffer.h" +#include "character.h" #include "charset.h" -#include "composite.h" #include "coding.h" #include "disptab.h" +#include "buffer.h" -#else /* not emacs */ +/*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) *** -#include "mulelib.h" + A coded character set ("charset" hereafter) is a meaningful + collection (i.e. language, culture, functionality, etc.) of + characters. Emacs handles multiple charsets at once. In Emacs Lisp + code, a charset is represented by a symbol. In C code, a charset is + represented by its ID number or by a pointer to a struct charset. -#endif /* emacs */ + The actual information about each charset is stored in two places. + Lispy information is stored in the hash table Vcharset_hash_table as + a vector (charset attributes). The other information is stored in + charset_table as a struct charset. -Lisp_Object Qcharset, Qascii, Qeight_bit_control, Qeight_bit_graphic; -Lisp_Object Qunknown; - -/* Declaration of special leading-codes. */ -EMACS_INT leading_code_private_11; /* for private DIMENSION1 of 1-column */ -EMACS_INT leading_code_private_12; /* for private DIMENSION1 of 2-column */ -EMACS_INT leading_code_private_21; /* for private DIMENSION2 of 1-column */ -EMACS_INT leading_code_private_22; /* for private DIMENSION2 of 2-column */ - -/* Declaration of special charsets. The values are set by - Fsetup_special_charsets. */ -int charset_latin_iso8859_1; /* ISO8859-1 (Latin-1) */ -int charset_jisx0208_1978; /* JISX0208.1978 (Japanese Kanji old set) */ -int charset_jisx0208; /* JISX0208.1983 (Japanese Kanji) */ -int charset_katakana_jisx0201; /* JISX0201.Kana (Japanese Katakana) */ -int charset_latin_jisx0201; /* JISX0201.Roman (Japanese Roman) */ -int charset_big5_1; /* Big5 Level 1 (Chinese Traditional) */ -int charset_big5_2; /* Big5 Level 2 (Chinese Traditional) */ -int charset_mule_unicode_0100_24ff; -int charset_mule_unicode_2500_33ff; -int charset_mule_unicode_e000_ffff; - -Lisp_Object Qcharset_table; - -/* A char-table containing information of each character set. */ -Lisp_Object Vcharset_table; - -/* A vector of charset symbol indexed by charset-id. This is used - only for returning charset symbol from C functions. */ -Lisp_Object Vcharset_symbol_table; - -/* A list of charset symbols ever defined. */ +*/ + +/* List of all charsets. This variable is used only from Emacs + Lisp. */ Lisp_Object Vcharset_list; -/* Vector of translation table ever defined. - ID of a translation table is used to index this vector. */ -Lisp_Object Vtranslation_table_vector; +/* Hash table that contains attributes of each charset. Keys are + charset symbols, and values are vectors of charset attributes. */ +Lisp_Object Vcharset_hash_table; -/* A char-table for characters which may invoke auto-filling. */ -Lisp_Object Vauto_fill_chars; +/* Table of struct charset. */ +struct charset *charset_table; -Lisp_Object Qauto_fill_chars; +static int charset_table_size; +static int charset_table_used; -/* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */ -int bytes_by_char_head[256]; -int width_by_char_head[256]; +Lisp_Object Qcharsetp; -/* Mapping table from ISO2022's charset (specified by DIMENSION, - CHARS, and FINAL-CHAR) to Emacs' charset. */ -int iso_charset_table[2][2][128]; +/* Special charset symbols. */ +Lisp_Object Qascii; +Lisp_Object Qeight_bit; +Lisp_Object Qiso_8859_1; +Lisp_Object Qunicode; + +/* The corresponding charsets. */ +int charset_ascii; +int charset_eight_bit; +int charset_iso_8859_1; +int charset_unicode; + +/* The other special charsets. */ +int charset_jisx0201_roman; +int charset_jisx0208_1978; +int charset_jisx0208; -/* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */ -unsigned char *_fetch_multibyte_char_p; -int _fetch_multibyte_char_len; +/* Value of charset attribute `charset-iso-plane'. */ +Lisp_Object Qgl, Qgr; -/* Offset to add to a non-ASCII value when inserting it. */ -EMACS_INT nonascii_insert_offset; +/* Charset of unibyte characters. */ +int charset_unibyte; -/* Translation table for converting non-ASCII unibyte characters - to multibyte codes, or nil. */ -Lisp_Object Vnonascii_translation_table; +/* List of charsets ordered by the priority. */ +Lisp_Object Vcharset_ordered_list; + +/* Incremented everytime we change Vcharset_ordered_list. This is + unsigned short so that it fits in Lisp_Int and never matches + -1. */ +unsigned short charset_ordered_list_tick; + +/* List of iso-2022 charsets. */ +Lisp_Object Viso_2022_charset_list; + +/* List of emacs-mule charsets. */ +Lisp_Object Vemacs_mule_charset_list; + +struct charset *emacs_mule_charset[256]; + +/* Mapping table from ISO2022's charset (specified by DIMENSION, + CHARS, and FINAL-CHAR) to Emacs' charset. */ +int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL]; + +Lisp_Object Vcharset_map_path; + +Lisp_Object Vchar_unified_charset_table; + +/* Defined in chartab.c */ +extern void +map_char_table_for_charset P_ ((void (*c_function) (Lisp_Object, Lisp_Object), + Lisp_Object function, Lisp_Object table, + Lisp_Object arg, struct charset *charset, + unsigned from, unsigned to)); + +#define CODE_POINT_TO_INDEX(charset, code) \ + ((charset)->code_linear_p \ + ? (code) - (charset)->min_code \ + : (((charset)->code_space_mask[(code) >> 24] & 0x8) \ + && ((charset)->code_space_mask[((code) >> 16) & 0xFF] & 0x4) \ + && ((charset)->code_space_mask[((code) >> 8) & 0xFF] & 0x2) \ + && ((charset)->code_space_mask[(code) & 0xFF] & 0x1)) \ + ? (((((code) >> 24) - (charset)->code_space[12]) \ + * (charset)->code_space[11]) \ + + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \ + * (charset)->code_space[7]) \ + + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \ + * (charset)->code_space[3]) \ + + (((code) & 0xFF) - (charset)->code_space[0]) \ + - ((charset)->char_index_offset)) \ + : -1) + + +/* Convert the character index IDX to code-point CODE for CHARSET. + It is assumed that IDX is in a valid range. */ + +#define INDEX_TO_CODE_POINT(charset, idx) \ + ((charset)->code_linear_p \ + ? (idx) + (charset)->min_code \ + : (idx += (charset)->char_index_offset, \ + (((charset)->code_space[0] + (idx) % (charset)->code_space[2]) \ + | (((charset)->code_space[4] \ + + ((idx) / (charset)->code_space[3] % (charset)->code_space[6])) \ + << 8) \ + | (((charset)->code_space[8] \ + + ((idx) / (charset)->code_space[7] % (charset)->code_space[10])) \ + << 16) \ + | (((charset)->code_space[12] + ((idx) / (charset)->code_space[11])) \ + << 24)))) -/* List of all possible generic characters. */ -Lisp_Object Vgeneric_character_list; -void -invalid_character (c) - int c; -{ - error ("Invalid character: %d, #o%o, #x%x", c, c, c); -} -/* Parse string STR of length LENGTH and fetch information of a - character at STR. Set BYTES to the byte length the character - occupies, CHARSET, C1, C2 to proper values of the character. */ - -#define SPLIT_MULTIBYTE_SEQ(str, length, bytes, charset, c1, c2) \ - do { \ - (c1) = *(str); \ - (bytes) = BYTES_BY_CHAR_HEAD (c1); \ - if ((bytes) == 1) \ - (charset) = ASCII_BYTE_P (c1) ? CHARSET_ASCII : CHARSET_8_BIT_GRAPHIC; \ - else if ((bytes) == 2) \ - { \ - if ((c1) == LEADING_CODE_8_BIT_CONTROL) \ - (charset) = CHARSET_8_BIT_CONTROL, (c1) = (str)[1] - 0x20; \ - else \ - (charset) = (c1), (c1) = (str)[1] & 0x7F; \ - } \ - else if ((bytes) == 3) \ - { \ - if ((c1) < LEADING_CODE_PRIVATE_11) \ - (charset) = (c1), (c1) = (str)[1] & 0x7F, (c2) = (str)[2] & 0x7F; \ - else \ - (charset) = (str)[1], (c1) = (str)[2] & 0x7F; \ - } \ - else \ - (charset) = (str)[1], (c1) = (str)[2] & 0x7F, (c2) = (str)[3] & 0x7F; \ - } while (0) - -/* 1 if CHARSET, C1, and C2 compose a valid character, else 0. - Note that this intentionally allows invalid components, such - as 0xA0 0xA0, because there exist many files that contain - such invalid byte sequences, especially in EUC-GB. */ -#define CHAR_COMPONENTS_VALID_P(charset, c1, c2) \ - ((charset) == CHARSET_ASCII \ - ? ((c1) >= 0 && (c1) <= 0x7F) \ - : ((charset) == CHARSET_8_BIT_CONTROL \ - ? ((c1) >= 0x80 && (c1) <= 0x9F) \ - : ((charset) == CHARSET_8_BIT_GRAPHIC \ - ? ((c1) >= 0x80 && (c1) <= 0xFF) \ - : (CHARSET_DIMENSION (charset) == 1 \ - ? ((c1) >= 0x20 && (c1) <= 0x7F) \ - : ((c1) >= 0x20 && (c1) <= 0x7F \ - && (c2) >= 0x20 && (c2) <= 0x7F))))) - -/* Store multi-byte form of the character C in STR. The caller should - allocate at least 4-byte area at STR in advance. Returns the - length of the multi-byte form. If C is an invalid character code, - return -1. */ +/* Set to 1 to warn that a charset map is loaded and thus a buffer + text and a string data may be relocated. */ +int charset_map_loaded; -int -char_to_string_1 (c, str) - int c; - unsigned char *str; +struct charset_map_entries { - unsigned char *p = str; + struct { + unsigned from, to; + int c; + } entry[0x10000]; + struct charset_map_entries *next; +}; + +/* Load the mapping information for CHARSET from ENTRIES. + + If CONTROL_FLAG is 0, setup CHARSET->min_char and CHARSET->max_char. + + If CONTROL_FLAG is 1, setup CHARSET->min_char, CHARSET->max_char, + CHARSET->decoder, and CHARSET->encoder. + + If CONTROL_FLAG is 2, setup CHARSET->deunifier and + Vchar_unify_table. If Vchar_unified_charset_table is non-nil, + setup it too. */ + +static void +load_charset_map (charset, entries, n_entries, control_flag) + struct charset *charset; + struct charset_map_entries *entries; + int n_entries; + int control_flag; +{ + Lisp_Object vec, table; + unsigned max_code = CHARSET_MAX_CODE (charset); + int ascii_compatible_p = charset->ascii_compatible_p; + int min_char, max_char, nonascii_min_char; + int i; + unsigned char *fast_map = charset->fast_map; - if (c & CHAR_MODIFIER_MASK) /* This includes the case C is negative. */ + if (n_entries <= 0) + return; + + if (control_flag > 0) { - /* Multibyte character can't have a modifier bit. */ - if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) - return -1; + int n = CODE_POINT_TO_INDEX (charset, max_code) + 1; + + table = Fmake_char_table (Qnil, Qnil); + if (control_flag == 1) + vec = Fmake_vector (make_number (n), make_number (-1)); + else if (! CHAR_TABLE_P (Vchar_unify_table)) + Vchar_unify_table = Fmake_char_table (Qnil, Qnil); + + charset_map_loaded = 1; + } - /* For Meta, Shift, and Control modifiers, we need special care. */ - if (c & CHAR_META) + min_char = max_char = entries->entry[0].c; + nonascii_min_char = MAX_CHAR; + for (i = 0; i < n_entries; i++) + { + unsigned from, to; + int from_index, to_index; + int from_c, to_c; + int idx = i % 0x10000; + + if (i > 0 && idx == 0) + entries = entries->next; + from = entries->entry[idx].from; + to = entries->entry[idx].to; + from_c = entries->entry[idx].c; + from_index = CODE_POINT_TO_INDEX (charset, from); + if (from == to) { - /* Move the meta bit to the right place for a string. */ - c = (c & ~CHAR_META) | 0x80; + to_index = from_index; + to_c = from_c; } - if (c & CHAR_SHIFT) + else { - /* Shift modifier is valid only with [A-Za-z]. */ - if ((c & 0377) >= 'A' && (c & 0377) <= 'Z') - c &= ~CHAR_SHIFT; - else if ((c & 0377) >= 'a' && (c & 0377) <= 'z') - c = (c & ~CHAR_SHIFT) - ('a' - 'A'); + to_index = CODE_POINT_TO_INDEX (charset, to); + to_c = from_c + (to_index - from_index); } - if (c & CHAR_CTL) + if (from_index < 0 || to_index < 0) + continue; + + if (control_flag < 2) { - /* Simulate the code in lread.c. */ - /* Allow `\C- ' and `\C-?'. */ - if (c == (CHAR_CTL | ' ')) - c = 0; - else if (c == (CHAR_CTL | '?')) - c = 127; - /* ASCII control chars are made from letters (both cases), - as well as the non-letters within 0100...0137. */ - else if ((c & 0137) >= 0101 && (c & 0137) <= 0132) - c &= (037 | (~0177 & ~CHAR_CTL)); - else if ((c & 0177) >= 0100 && (c & 0177) <= 0137) - c &= (037 | (~0177 & ~CHAR_CTL)); + int c; + + if (to_c > max_char) + max_char = to_c; + else if (from_c < min_char) + min_char = from_c; + if (ascii_compatible_p) + { + if (! ASCII_BYTE_P (from_c)) + { + if (from_c < nonascii_min_char) + nonascii_min_char = from_c; + } + else if (! ASCII_BYTE_P (to_c)) + { + nonascii_min_char = 0x80; + } + } + + for (c = from_c; c <= to_c; c++) + CHARSET_FAST_MAP_SET (c, fast_map); + + if (control_flag == 1) + { + unsigned code = from; + + if (CHARSET_COMPACT_CODES_P (charset)) + while (1) + { + ASET (vec, from_index, make_number (from_c)); + if (NILP (CHAR_TABLE_REF (table, from_c))) + CHAR_TABLE_SET (table, from_c, make_number (code)); + if (from_index == to_index) + break; + from_index++, from_c++; + code = INDEX_TO_CODE_POINT (charset, from_index); + } + else + for (; from_index <= to_index; from_index++, from_c++) + { + ASET (vec, from_index, make_number (from_c)); + if (NILP (CHAR_TABLE_REF (table, from_c))) + CHAR_TABLE_SET (table, from_c, make_number (from_index)); + } + } } + else + { + unsigned code = from; - /* If C still has any modifier bits, just ignore it. */ - c &= ~CHAR_MODIFIER_MASK; + while (1) + { + int c1 = DECODE_CHAR (charset, code); + + if (c1 >= 0) + { + CHAR_TABLE_SET (table, from_c, make_number (c1)); + CHAR_TABLE_SET (Vchar_unify_table, c1, make_number (from_c)); + if (CHAR_TABLE_P (Vchar_unified_charset_table)) + CHAR_TABLE_SET (Vchar_unified_charset_table, c1, + CHARSET_NAME (charset)); + } + if (from_index == to_index) + break; + from_index++, from_c++; + code = INDEX_TO_CODE_POINT (charset, from_index); + } + } } - if (SINGLE_BYTE_CHAR_P (c)) + if (control_flag < 2) { - if (ASCII_BYTE_P (c) || c >= 0xA0) - *p++ = c; - else + CHARSET_MIN_CHAR (charset) = (ascii_compatible_p + ? nonascii_min_char : min_char); + CHARSET_MAX_CHAR (charset) = max_char; + if (control_flag == 1) { - *p++ = LEADING_CODE_8_BIT_CONTROL; - *p++ = c + 0x20; + CHARSET_DECODER (charset) = vec; + CHARSET_ENCODER (charset) = table; } } - else if (CHAR_VALID_P (c, 0)) - { - int charset, c1, c2; + else + CHARSET_DEUNIFIER (charset) = table; +} - SPLIT_CHAR (c, charset, c1, c2); - if (charset >= LEADING_CODE_EXT_11) - *p++ = (charset < LEADING_CODE_EXT_12 - ? LEADING_CODE_PRIVATE_11 - : (charset < LEADING_CODE_EXT_21 - ? LEADING_CODE_PRIVATE_12 - : (charset < LEADING_CODE_EXT_22 - ? LEADING_CODE_PRIVATE_21 - : LEADING_CODE_PRIVATE_22))); - *p++ = charset; - if ((c1 > 0 && c1 < 32) || (c2 > 0 && c2 < 32)) - return -1; - if (c1) +/* Read a hexadecimal number (preceded by "0x") from the file FP while + paying attention to comment charcter '#'. */ + +static INLINE unsigned +read_hex (fp, eof) + FILE *fp; + int *eof; +{ + int c; + unsigned n; + + while ((c = getc (fp)) != EOF) + { + if (c == '#') { - *p++ = c1 | 0x80; - if (c2 > 0) - *p++ = c2 | 0x80; + while ((c = getc (fp)) != EOF && c != '\n'); + } + else if (c == '0') + { + if ((c = getc (fp)) == EOF || c == 'x') + break; } } + if (c == EOF) + { + *eof = 1; + return 0; + } + *eof = 0; + n = 0; + if (c == 'x') + while ((c = getc (fp)) != EOF && isxdigit (c)) + n = ((n << 4) + | (c <= '9' ? c - '0' : c <= 'F' ? c - 'A' + 10 : c - 'a' + 10)); else - return -1; - - return (p - str); + while ((c = getc (fp)) != EOF && isdigit (c)) + n = (n * 10) + c - '0'; + if (c != EOF) + ungetc (c, fp); + return n; } -/* Store multi-byte form of the character C in STR. The caller should - allocate at least 4-byte area at STR in advance. Returns the - length of the multi-byte form. If C is an invalid character code, - signal an error. +/* Return a mapping vector for CHARSET loaded from MAPFILE. + Each line of MAPFILE has this form + 0xAAAA 0xCCCC + where 0xAAAA is a code-point and 0xCCCC is the corresponding + character code, or this form + 0xAAAA-0xBBBB 0xCCCC + where 0xAAAA and 0xBBBB are code-points specifying a range, and + 0xCCCC is the first character code of the range. - Use macro `CHAR_STRING (C, STR)' instead of calling this function - directly if C can be an ASCII character. */ + The returned vector has this form: + [ CODE1 CHAR1 CODE2 CHAR2 .... ] + where CODE1 is a code-point or a cons of code-points specifying a + range. */ -int -char_to_string (c, str) - int c; - unsigned char *str; +extern void add_to_log P_ ((char *, Lisp_Object, Lisp_Object)); + +static void +load_charset_map_from_file (charset, mapfile, control_flag) + struct charset *charset; + Lisp_Object mapfile; + int control_flag; { - int len; - len = char_to_string_1 (c, str); - if (len == -1) - invalid_character (c); - return len; -} + unsigned min_code = CHARSET_MIN_CODE (charset); + unsigned max_code = CHARSET_MAX_CODE (charset); + int fd; + FILE *fp; + int eof; + Lisp_Object suffixes; + struct charset_map_entries *head, *entries; + int n_entries; + + suffixes = Fcons (build_string (".map"), + Fcons (build_string (".TXT"), Qnil)); + + fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil); + if (fd < 0 + || ! (fp = fdopen (fd, "r"))) + { + add_to_log ("Failure in loading charset map: %S", mapfile, Qnil); + return; + } + head = entries = ((struct charset_map_entries *) + alloca (sizeof (struct charset_map_entries))); + n_entries = 0; + eof = 0; + while (1) + { + unsigned from, to; + int c; + int idx; -/* Return the non-ASCII character corresponding to multi-byte form at - STR of length LEN. If ACTUAL_LEN is not NULL, store the byte - length of the multibyte form in *ACTUAL_LEN. + from = read_hex (fp, &eof); + if (eof) + break; + if (getc (fp) == '-') + to = read_hex (fp, &eof); + else + to = from; + c = (int) read_hex (fp, &eof); - Use macros STRING_CHAR or STRING_CHAR_AND_LENGTH instead of calling - this function directly if you want ot handle ASCII characters as - well. */ + if (from < min_code || to > max_code || from > to || c > MAX_CHAR) + continue; -int -string_to_char (str, len, actual_len) - const unsigned char *str; - int len, *actual_len; -{ - int c, bytes, charset, c1, c2; + if (n_entries > 0 && (n_entries % 0x10000) == 0) + { + entries->next = ((struct charset_map_entries *) + alloca (sizeof (struct charset_map_entries))); + entries = entries->next; + } + idx = n_entries % 0x10000; + entries->entry[idx].from = from; + entries->entry[idx].to = to; + entries->entry[idx].c = c; + n_entries++; + } + fclose (fp); + close (fd); - SPLIT_MULTIBYTE_SEQ (str, len, bytes, charset, c1, c2); - c = MAKE_CHAR (charset, c1, c2); - if (actual_len) - *actual_len = bytes; - return c; + load_charset_map (charset, head, n_entries, control_flag); } -/* Return the length of the multi-byte form at string STR of length LEN. - Use the macro MULTIBYTE_FORM_LENGTH instead. */ -int -multibyte_form_length (str, len) - const unsigned char *str; - int len; +static void +load_charset_map_from_vector (charset, vec, control_flag) + struct charset *charset; + Lisp_Object vec; + int control_flag; { - int bytes; + unsigned min_code = CHARSET_MIN_CODE (charset); + unsigned max_code = CHARSET_MAX_CODE (charset); + struct charset_map_entries *head, *entries; + int n_entries; + int len = ASIZE (vec); + int i; - PARSE_MULTIBYTE_SEQ (str, len, bytes); - return bytes; -} + if (len % 2 == 1) + { + add_to_log ("Failure in loading charset map: %V", vec, Qnil); + return; + } -/* Check multibyte form at string STR of length LEN and set variables - pointed by CHARSET, C1, and C2 to charset and position codes of the - character at STR, and return 0. If there's no multibyte character, - return -1. This should be used only in the macro SPLIT_STRING - which checks range of STR in advance. */ + head = entries = ((struct charset_map_entries *) + alloca (sizeof (struct charset_map_entries))); + n_entries = 0; + for (i = 0; i < len; i += 2) + { + Lisp_Object val, val2; + unsigned from, to; + int c; + int idx; -int -split_string (str, len, charset, c1, c2) - const unsigned char *str; - unsigned char *c1, *c2; - int len, *charset; -{ - register int bytes, cs, code1, code2 = -1; + val = AREF (vec, i); + if (CONSP (val)) + { + val2 = XCDR (val); + val = XCAR (val); + CHECK_NATNUM (val); + CHECK_NATNUM (val2); + from = XFASTINT (val); + to = XFASTINT (val2); + } + else + { + CHECK_NATNUM (val); + from = to = XFASTINT (val); + } + val = AREF (vec, i + 1); + CHECK_NATNUM (val); + c = XFASTINT (val); - SPLIT_MULTIBYTE_SEQ (str, len, bytes, cs, code1, code2); - if (cs == CHARSET_ASCII) - return -1; - *charset = cs; - *c1 = code1; - *c2 = code2; - return 0; + if (from < min_code || to > max_code || from > to || c > MAX_CHAR) + continue; + + if (n_entries > 0 && (n_entries % 0x10000) == 0) + { + entries->next = ((struct charset_map_entries *) + alloca (sizeof (struct charset_map_entries))); + entries = entries->next; + } + idx = n_entries % 0x10000; + entries->entry[idx].from = from; + entries->entry[idx].to = to; + entries->entry[idx].c = c; + n_entries++; + } + + load_charset_map (charset, head, n_entries, control_flag); } -/* Return 1 if character C has valid printable glyph. - Use the macro CHAR_PRINTABLE_P instead. */ -int -char_printable_p (c) - int c; +static void +load_charset (charset) + struct charset *charset; { - int charset, c1, c2; - - if (ASCII_BYTE_P (c)) - return 1; - else if (SINGLE_BYTE_CHAR_P (c)) - return 0; - else if (c >= MAX_CHAR) - return 0; + if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP_DEFERRED) + { + Lisp_Object map; - SPLIT_CHAR (c, charset, c1, c2); - if (! CHARSET_DEFINED_P (charset)) - return 0; - if (CHARSET_CHARS (charset) == 94 - ? c1 <= 32 || c1 >= 127 - : c1 < 32) - return 0; - if (CHARSET_DIMENSION (charset) == 2 - && (CHARSET_CHARS (charset) == 94 - ? c2 <= 32 || c2 >= 127 - : c2 < 32)) - return 0; - return 1; + map = CHARSET_MAP (charset); + if (STRINGP (map)) + load_charset_map_from_file (charset, map, 1); + else + load_charset_map_from_vector (charset, map, 1); + CHARSET_METHOD (charset) = CHARSET_METHOD_MAP; + } } -/* Translate character C by translation table TABLE. If C - is negative, translate a character specified by CHARSET, C1, and C2 - (C1 and C2 are code points of the character). If no translation is - found in TABLE, return C. */ -int -translate_char (table, c, charset, c1, c2) - Lisp_Object table; - int c, charset, c1, c2; + +DEFUN ("charsetp", Fcharsetp, Scharsetp, 1, 1, 0, + doc: /* Return non-nil if and only if OBJECT is a charset.*/) + (object) + Lisp_Object object; { - Lisp_Object ch; - int alt_charset, alt_c1, alt_c2, dimension; - - if (c < 0) c = MAKE_CHAR (charset, (c1 & 0x7F) , (c2 & 0x7F)); - if (!CHAR_TABLE_P (table) - || (ch = Faref (table, make_number (c)), !NATNUMP (ch))) - return c; - - SPLIT_CHAR (XFASTINT (ch), alt_charset, alt_c1, alt_c2); - dimension = CHARSET_DIMENSION (alt_charset); - if ((dimension == 1 && alt_c1 > 0) || (dimension == 2 && alt_c2 > 0)) - /* CH is not a generic character, just return it. */ - return XFASTINT (ch); - - /* Since CH is a generic character, we must return a specific - charater which has the same position codes as C from CH. */ - if (charset < 0) - SPLIT_CHAR (c, charset, c1, c2); - if (dimension != CHARSET_DIMENSION (charset)) - /* We can't make such a character because of dimension mismatch. */ - return c; - return MAKE_CHAR (alt_charset, c1, c2); + return (CHARSETP (object) ? Qt : Qnil); } -/* Convert the unibyte character C to multibyte based on - Vnonascii_translation_table or nonascii_insert_offset. If they can't - convert C to a valid multibyte character, convert it based on - DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */ -int -unibyte_char_to_multibyte (c) - int c; +void +map_charset_chars (c_function, function, arg, + charset, from, to) + void (*c_function) P_ ((Lisp_Object, Lisp_Object)); + Lisp_Object function, arg; + struct charset *charset; + unsigned from, to; { - if (c < 0400 && c >= 0200) + Lisp_Object range; + int partial; + + if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP_DEFERRED) + load_charset (charset); + + partial = (from > CHARSET_MIN_CODE (charset) + || to < CHARSET_MAX_CODE (charset)); + + if (CHARSET_UNIFIED_P (charset) + && CHAR_TABLE_P (CHARSET_DEUNIFIER (charset))) { - int c_save = c; + map_char_table_for_charset (c_function, function, + CHARSET_DEUNIFIER (charset), arg, + partial ? charset : NULL, from, to); + } - if (! NILP (Vnonascii_translation_table)) - { - c = XINT (Faref (Vnonascii_translation_table, make_number (c))); - if (c >= 0400 && ! char_valid_p (c, 0)) - c = c_save + DEFAULT_NONASCII_INSERT_OFFSET; - } - else if (c >= 0240 && nonascii_insert_offset > 0) + if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET) + { + int from_idx = CODE_POINT_TO_INDEX (charset, from); + int to_idx = CODE_POINT_TO_INDEX (charset, to); + int from_c = from_idx + CHARSET_CODE_OFFSET (charset); + int to_c = to_idx + CHARSET_CODE_OFFSET (charset); + + range = Fcons (make_number (from_c), make_number (to_c)); + if (NILP (function)) + (*c_function) (arg, range); + else + call2 (function, range, arg); + } + else if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP) + { + if (! CHAR_TABLE_P (CHARSET_ENCODER (charset))) + return; + map_char_table_for_charset (c_function, function, + CHARSET_ENCODER (charset), arg, + partial ? charset : NULL, from, to); + } + else if (CHARSET_METHOD (charset) == CHARSET_METHOD_SUBSET) + { + Lisp_Object subset_info; + int offset; + + subset_info = CHARSET_SUBSET (charset); + charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0))); + offset = XINT (AREF (subset_info, 3)); + from -= offset; + if (from < XFASTINT (AREF (subset_info, 1))) + from = XFASTINT (AREF (subset_info, 1)); + to -= offset; + if (to > XFASTINT (AREF (subset_info, 2))) + to = XFASTINT (AREF (subset_info, 2)); + map_charset_chars (c_function, function, arg, charset, from, to); + } + else /* i.e. CHARSET_METHOD_SUPERSET */ + { + Lisp_Object parents; + + for (parents = CHARSET_SUPERSET (charset); CONSP (parents); + parents = XCDR (parents)) { - c += nonascii_insert_offset; - if (c < 0400 || ! char_valid_p (c, 0)) - c = c_save + DEFAULT_NONASCII_INSERT_OFFSET; + int offset; + unsigned this_from, this_to; + + charset = CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents)))); + offset = XINT (XCDR (XCAR (parents))); + this_from = from - offset; + this_to = to - offset; + if (this_from < CHARSET_MIN_CODE (charset)) + this_from = CHARSET_MIN_CODE (charset); + if (this_to > CHARSET_MAX_CODE (charset)) + this_to = CHARSET_MAX_CODE (charset); + map_charset_chars (c_function, function, arg, charset, + this_from, this_to); } - else if (c >= 0240) - c = c_save + DEFAULT_NONASCII_INSERT_OFFSET; } - return c; } +DEFUN ("map-charset-chars", Fmap_charset_chars, Smap_charset_chars, 2, 5, 0, + doc: /* Call FUNCTION for all characters in CHARSET. +FUNCTION is called with an argument RANGE and the optional 3rd +argument ARG. -/* Convert the multibyte character C to unibyte 8-bit character based - on Vnonascii_translation_table or nonascii_insert_offset. If - REV_TBL is non-nil, it should be a reverse table of - Vnonascii_translation_table, i.e. what given by: - Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */ +RANGE is a cons (FROM . TO), where FROM and TO indicate a range of +characters contained in CHARSET. -int -multibyte_char_to_unibyte (c, rev_tbl) - int c; - Lisp_Object rev_tbl; +The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the +range of code points of target characters. */) + (function, charset, arg, from_code, to_code) + Lisp_Object function, charset, arg, from_code, to_code; { - if (!SINGLE_BYTE_CHAR_P (c)) + struct charset *cs; + unsigned from, to; + + CHECK_CHARSET_GET_CHARSET (charset, cs); + if (NILP (from_code)) + from = CHARSET_MIN_CODE (cs); + else { - int c_save = c; + CHECK_NATNUM (from_code); + from = XINT (from_code); + if (from < CHARSET_MIN_CODE (cs)) + from = CHARSET_MIN_CODE (cs); + } + if (NILP (to_code)) + to = CHARSET_MAX_CODE (cs); + else + { + CHECK_NATNUM (to_code); + to = XINT (to_code); + if (to > CHARSET_MAX_CODE (cs)) + to = CHARSET_MAX_CODE (cs); + } + map_charset_chars (NULL, function, arg, cs, from, to); + return Qnil; +} + + +/* Define a charset according to the arguments. The Nth argument is + the Nth attribute of the charset (the last attribute `charset-id' + is not included). See the docstring of `define-charset' for the + detail. */ + +DEFUN ("define-charset-internal", Fdefine_charset_internal, + Sdefine_charset_internal, charset_arg_max, MANY, 0, + doc: /* For internal use only. +usage: (define-charset-internal ...) */) + (nargs, args) + int nargs; + Lisp_Object *args; +{ + /* Charset attr vector. */ + Lisp_Object attrs; + Lisp_Object val; + unsigned hash_code; + struct Lisp_Hash_Table *hash_table = XHASH_TABLE (Vcharset_hash_table); + int i, j; + struct charset charset; + int id; + int dimension; + int new_definition_p; + int nchars; + + if (nargs != charset_arg_max) + return Fsignal (Qwrong_number_of_arguments, + Fcons (intern ("define-charset-internal"), + make_number (nargs))); + + attrs = Fmake_vector (make_number (charset_attr_max), Qnil); + + CHECK_SYMBOL (args[charset_arg_name]); + ASET (attrs, charset_name, args[charset_arg_name]); + + val = args[charset_arg_code_space]; + for (i = 0, dimension = 0, nchars = 1; i < 4; i++) + { + int min_byte, max_byte; + + min_byte = XINT (Faref (val, make_number (i * 2))); + max_byte = XINT (Faref (val, make_number (i * 2 + 1))); + if (min_byte < 0 || min_byte > max_byte || max_byte >= 256) + error ("Invalid :code-space value"); + charset.code_space[i * 4] = min_byte; + charset.code_space[i * 4 + 1] = max_byte; + charset.code_space[i * 4 + 2] = max_byte - min_byte + 1; + nchars *= charset.code_space[i * 4 + 2]; + charset.code_space[i * 4 + 3] = nchars; + if (max_byte > 0) + dimension = i + 1; + } - if (! CHAR_TABLE_P (rev_tbl) - && CHAR_TABLE_P (Vnonascii_translation_table)) - rev_tbl = Fchar_table_extra_slot (Vnonascii_translation_table, - make_number (0)); - if (CHAR_TABLE_P (rev_tbl)) + val = args[charset_arg_dimension]; + if (NILP (val)) + charset.dimension = dimension; + else + { + CHECK_NATNUM (val); + charset.dimension = XINT (val); + if (charset.dimension < 1 || charset.dimension > 4) + args_out_of_range_3 (val, make_number (1), make_number (4)); + } + + charset.code_linear_p + = (charset.dimension == 1 + || (charset.code_space[2] == 256 + && (charset.dimension == 2 + || (charset.code_space[6] == 256 + && (charset.dimension == 3 + || charset.code_space[10] == 256))))); + + if (! charset.code_linear_p) + { + charset.code_space_mask = (unsigned char *) xmalloc (256); + bzero (charset.code_space_mask, 256); + for (i = 0; i < 4; i++) + for (j = charset.code_space[i * 4]; j <= charset.code_space[i * 4 + 1]; + j++) + charset.code_space_mask[j] |= (1 << i); + } + + charset.iso_chars_96 = charset.code_space[2] == 96; + + charset.min_code = (charset.code_space[0] + | (charset.code_space[4] << 8) + | (charset.code_space[8] << 16) + | (charset.code_space[12] << 24)); + charset.max_code = (charset.code_space[1] + | (charset.code_space[5] << 8) + | (charset.code_space[9] << 16) + | (charset.code_space[13] << 24)); + charset.char_index_offset = 0; + + val = args[charset_arg_min_code]; + if (! NILP (val)) + { + unsigned code; + + if (INTEGERP (val)) + code = XINT (val); + else { - Lisp_Object temp; - temp = Faref (rev_tbl, make_number (c)); - if (INTEGERP (temp)) - c = XINT (temp); - if (c >= 256) - c = (c_save & 0177) + 0200; + CHECK_CONS (val); + CHECK_NUMBER_CAR (val); + CHECK_NUMBER_CDR (val); + code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val))); } + if (code < charset.min_code + || code > charset.max_code) + args_out_of_range_3 (make_number (charset.min_code), + make_number (charset.max_code), val); + charset.char_index_offset = CODE_POINT_TO_INDEX (&charset, code); + charset.min_code = code; + } + + val = args[charset_arg_max_code]; + if (! NILP (val)) + { + unsigned code; + + if (INTEGERP (val)) + code = XINT (val); else { - if (nonascii_insert_offset > 0) - c -= nonascii_insert_offset; - if (c < 128 || c >= 256) - c = (c_save & 0177) + 0200; + CHECK_CONS (val); + CHECK_NUMBER_CAR (val); + CHECK_NUMBER_CDR (val); + code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val))); } + if (code < charset.min_code + || code > charset.max_code) + args_out_of_range_3 (make_number (charset.min_code), + make_number (charset.max_code), val); + charset.max_code = code; } - return c; -} + charset.compact_codes_p = charset.max_code < 0x1000000; - -/* Update the table Vcharset_table with the given arguments (see the - document of `define-charset' for the meaning of each argument). - Several other table contents are also updated. The caller should - check the validity of CHARSET-ID and the remaining arguments in - advance. */ + val = args[charset_arg_invalid_code]; + if (NILP (val)) + { + if (charset.min_code > 0) + charset.invalid_code = 0; + else + { + XSETINT (val, charset.max_code + 1); + if (XINT (val) == charset.max_code + 1) + charset.invalid_code = charset.max_code + 1; + else + error ("Attribute :invalid-code must be specified"); + } + } + else + { + CHECK_NATNUM (val); + charset.invalid_code = XFASTINT (val); + } -void -update_charset_table (charset_id, dimension, chars, width, direction, - iso_final_char, iso_graphic_plane, - short_name, long_name, description) - Lisp_Object charset_id, dimension, chars, width, direction; - Lisp_Object iso_final_char, iso_graphic_plane; - Lisp_Object short_name, long_name, description; -{ - int charset = XINT (charset_id); - int bytes; - unsigned char leading_code_base, leading_code_ext; - - if (NILP (CHARSET_TABLE_ENTRY (charset))) - CHARSET_TABLE_ENTRY (charset) - = Fmake_vector (make_number (CHARSET_MAX_IDX), Qnil); - - if (NILP (long_name)) - long_name = short_name; - if (NILP (description)) - description = long_name; - - /* Get byte length of multibyte form, base leading-code, and - extended leading-code of the charset. See the comment under the - title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */ - bytes = XINT (dimension); - if (charset < MIN_CHARSET_PRIVATE_DIMENSION1) - { - /* Official charset, it doesn't have an extended leading-code. */ - if (charset != CHARSET_ASCII && charset != CHARSET_8_BIT_GRAPHIC) - bytes += 1; /* For a base leading-code. */ - leading_code_base = charset; - leading_code_ext = 0; + val = args[charset_arg_iso_final]; + if (NILP (val)) + charset.iso_final = -1; + else + { + CHECK_NUMBER (val); + if (XINT (val) < '0' || XINT (val) > 127) + error ("Invalid iso-final-char: %d", XINT (val)); + charset.iso_final = XINT (val); } + + val = args[charset_arg_iso_revision]; + if (NILP (val)) + charset.iso_revision = -1; else { - /* Private charset. */ - bytes += 2; /* For base and extended leading-codes. */ - leading_code_base - = (charset < LEADING_CODE_EXT_12 - ? LEADING_CODE_PRIVATE_11 - : (charset < LEADING_CODE_EXT_21 - ? LEADING_CODE_PRIVATE_12 - : (charset < LEADING_CODE_EXT_22 - ? LEADING_CODE_PRIVATE_21 - : LEADING_CODE_PRIVATE_22))); - leading_code_ext = charset; - if (BYTES_BY_CHAR_HEAD (leading_code_base) != bytes) - error ("Invalid dimension for the charset-ID %d", charset); - } - - CHARSET_TABLE_INFO (charset, CHARSET_ID_IDX) = charset_id; - CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX) = make_number (bytes); - CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX) = dimension; - CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX) = chars; - CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX) = width; - CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX) = direction; - CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX) - = make_number (leading_code_base); - CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX) - = make_number (leading_code_ext); - CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX) = iso_final_char; - CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX) - = iso_graphic_plane; - CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX) = short_name; - CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX) = long_name; - CHARSET_TABLE_INFO (charset, CHARSET_DESCRIPTION_IDX) = description; - CHARSET_TABLE_INFO (charset, CHARSET_PLIST_IDX) = Qnil; + CHECK_NUMBER (val); + if (XINT (val) > 63) + args_out_of_range (make_number (63), val); + charset.iso_revision = XINT (val); + } - { - /* If we have already defined a charset which has the same - DIMENSION, CHARS and ISO-FINAL-CHAR but the different - DIRECTION, we must update the entry REVERSE-CHARSET of both - charsets. If there's no such charset, the value of the entry - is set to nil. */ - int i; - - for (i = 0; i <= MAX_CHARSET; i++) - if (!NILP (CHARSET_TABLE_ENTRY (i))) + val = args[charset_arg_emacs_mule_id]; + if (NILP (val)) + charset.emacs_mule_id = -1; + else + { + CHECK_NATNUM (val); + if ((XINT (val) > 0 && XINT (val) <= 128) || XINT (val) >= 256) + error ("Invalid emacs-mule-id: %d", XINT (val)); + charset.emacs_mule_id = XINT (val); + } + + charset.ascii_compatible_p = ! NILP (args[charset_arg_ascii_compatible_p]); + + charset.supplementary_p = ! NILP (args[charset_arg_supplementary_p]); + + charset.unified_p = 0; + + bzero (charset.fast_map, sizeof (charset.fast_map)); + + if (! NILP (args[charset_arg_code_offset])) + { + val = args[charset_arg_code_offset]; + CHECK_NUMBER (val); + + charset.method = CHARSET_METHOD_OFFSET; + charset.code_offset = XINT (val); + + i = CODE_POINT_TO_INDEX (&charset, charset.min_code); + charset.min_char = i + charset.code_offset; + i = CODE_POINT_TO_INDEX (&charset, charset.max_code); + charset.max_char = i + charset.code_offset; + if (charset.max_char > MAX_CHAR) + error ("Unsupported max char: %d", charset.max_char); + + i = (charset.min_char >> 7) << 7; + for (; i < 0x10000 && i <= charset.max_char; i += 128) + CHARSET_FAST_MAP_SET (i, charset.fast_map); + i = (i >> 12) << 12; + for (; i <= charset.max_char; i += 0x1000) + CHARSET_FAST_MAP_SET (i, charset.fast_map); + } + else if (! NILP (args[charset_arg_map])) + { + val = args[charset_arg_map]; + ASET (attrs, charset_map, val); + if (STRINGP (val)) + load_charset_map_from_file (&charset, val, 0); + else + load_charset_map_from_vector (&charset, val, 0); + charset.method = CHARSET_METHOD_MAP_DEFERRED; + } + else if (! NILP (args[charset_arg_subset])) + { + Lisp_Object parent; + Lisp_Object parent_min_code, parent_max_code, parent_code_offset; + struct charset *parent_charset; + + val = args[charset_arg_subset]; + parent = Fcar (val); + CHECK_CHARSET_GET_CHARSET (parent, parent_charset); + parent_min_code = Fnth (make_number (1), val); + CHECK_NATNUM (parent_min_code); + parent_max_code = Fnth (make_number (2), val); + CHECK_NATNUM (parent_max_code); + parent_code_offset = Fnth (make_number (3), val); + CHECK_NUMBER (parent_code_offset); + val = Fmake_vector (make_number (4), Qnil); + ASET (val, 0, make_number (parent_charset->id)); + ASET (val, 1, parent_min_code); + ASET (val, 2, parent_max_code); + ASET (val, 3, parent_code_offset); + ASET (attrs, charset_subset, val); + + charset.method = CHARSET_METHOD_SUBSET; + /* Here, we just copy the parent's fast_map. It's not accurate, + but at least it works for quickly detecting which character + DOESN'T belong to this charset. */ + for (i = 0; i < 190; i++) + charset.fast_map[i] = parent_charset->fast_map[i]; + + /* We also copy these for parents. */ + charset.min_char = parent_charset->min_char; + charset.max_char = parent_charset->max_char; + } + else if (! NILP (args[charset_arg_superset])) + { + val = args[charset_arg_superset]; + charset.method = CHARSET_METHOD_SUPERSET; + val = Fcopy_sequence (val); + ASET (attrs, charset_superset, val); + + charset.min_char = MAX_CHAR; + charset.max_char = 0; + for (; ! NILP (val); val = Fcdr (val)) { - if (CHARSET_DIMENSION (i) == XINT (dimension) - && CHARSET_CHARS (i) == XINT (chars) - && CHARSET_ISO_FINAL_CHAR (i) == XINT (iso_final_char) - && CHARSET_DIRECTION (i) != XINT (direction)) + Lisp_Object elt, car_part, cdr_part; + int this_id, offset; + struct charset *this_charset; + + elt = Fcar (val); + if (CONSP (elt)) + { + car_part = XCAR (elt); + cdr_part = XCDR (elt); + CHECK_CHARSET_GET_ID (car_part, this_id); + CHECK_NUMBER (cdr_part); + offset = XINT (cdr_part); + } + else { - CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX) - = make_number (i); - CHARSET_TABLE_INFO (i, CHARSET_REVERSE_CHARSET_IDX) = charset_id; - break; + CHECK_CHARSET_GET_ID (elt, this_id); + offset = 0; } + XSETCAR (val, Fcons (make_number (this_id), make_number (offset))); + + this_charset = CHARSET_FROM_ID (this_id); + if (charset.min_char > this_charset->min_char) + charset.min_char = this_charset->min_char; + if (charset.max_char < this_charset->max_char) + charset.max_char = this_charset->max_char; + for (i = 0; i < 190; i++) + charset.fast_map[i] |= this_charset->fast_map[i]; } - if (i > MAX_CHARSET) - /* No such a charset. */ - CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX) - = make_number (-1); - } + } + else + error ("None of :code-offset, :map, :parents are specified"); - if (charset != CHARSET_ASCII && charset != CHARSET_8_BIT_GRAPHIC - && charset < MIN_CHARSET_PRIVATE_DIMENSION1) + val = args[charset_arg_unify_map]; + if (! NILP (val) && !STRINGP (val)) + CHECK_VECTOR (val); + ASET (attrs, charset_unify_map, val); + + CHECK_LIST (args[charset_arg_plist]); + ASET (attrs, charset_plist, args[charset_arg_plist]); + + charset.hash_index = hash_lookup (hash_table, args[charset_arg_name], + &hash_code); + if (charset.hash_index >= 0) + { + new_definition_p = 0; + id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name])); + HASH_VALUE (hash_table, charset.hash_index) = attrs; + } + else { - bytes_by_char_head[leading_code_base] = bytes; - width_by_char_head[leading_code_base] = XINT (width); + charset.hash_index = hash_put (hash_table, args[charset_arg_name], attrs, + hash_code); + if (charset_table_used == charset_table_size) + { + struct charset *new_table + = (struct charset *) xmalloc (sizeof (struct charset) + * (charset_table_size + 16)); + bcopy (charset_table, new_table, + sizeof (struct charset) * charset_table_size); + charset_table_size += 16; + charset_table = new_table; + } + id = charset_table_used++; + new_definition_p = 1; + } - /* Update table emacs_code_class. */ - emacs_code_class[charset] = (bytes == 2 - ? EMACS_leading_code_2 - : (bytes == 3 - ? EMACS_leading_code_3 - : EMACS_leading_code_4)); + ASET (attrs, charset_id, make_number (id)); + charset.id = id; + charset_table[id] = charset; + + if (charset.iso_final >= 0) + { + ISO_CHARSET_TABLE (charset.dimension, charset.iso_chars_96, + charset.iso_final) = id; + if (new_definition_p) + Viso_2022_charset_list = nconc2 (Viso_2022_charset_list, + Fcons (make_number (id), Qnil)); + if (ISO_CHARSET_TABLE (1, 0, 'J') == id) + charset_jisx0201_roman = id; + else if (ISO_CHARSET_TABLE (2, 0, '@') == id) + charset_jisx0208_1978 = id; + else if (ISO_CHARSET_TABLE (2, 0, 'B') == id) + charset_jisx0208 = id; + } + + if (charset.emacs_mule_id >= 0) + { + emacs_mule_charset[charset.emacs_mule_id] = CHARSET_FROM_ID (id); + if (charset.emacs_mule_id < 0xA0) + emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 1; + else + emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 2; + if (new_definition_p) + Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list, + Fcons (make_number (id), Qnil)); } - /* Update table iso_charset_table. */ - if (XINT (iso_final_char) >= 0 - && ISO_CHARSET_TABLE (dimension, chars, iso_final_char) < 0) - ISO_CHARSET_TABLE (dimension, chars, iso_final_char) = charset; + if (new_definition_p) + { + Vcharset_list = Fcons (args[charset_arg_name], Vcharset_list); + if (charset.supplementary_p) + Vcharset_ordered_list = nconc2 (Vcharset_ordered_list, + Fcons (make_number (id), Qnil)); + else + Vcharset_ordered_list = Fcons (make_number (id), + Vcharset_ordered_list); + charset_ordered_list_tick++; + } + + return Qnil; } -#ifdef emacs -/* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL - is invalid. */ -int -get_charset_id (charset_symbol) - Lisp_Object charset_symbol; +/* Same as Fdefine_charset_internal but arguments are more convenient + to call from C (typically in syms_of_charset). This can define a + charset of `offset' method only. Return the ID of the new + charset. */ + +static int +define_charset_internal (name, dimension, code_space, min_code, max_code, + iso_final, iso_revision, emacs_mule_id, + ascii_compatible, supplementary, + code_offset) + Lisp_Object name; + int dimension; + unsigned char *code_space; + unsigned min_code, max_code; + int iso_final, iso_revision, emacs_mule_id; + int ascii_compatible, supplementary; + int code_offset; { + Lisp_Object args[charset_arg_max]; + Lisp_Object plist[14]; Lisp_Object val; - int charset; - - /* This originally used a ?: operator, but reportedly the HP-UX - compiler version HP92453-01 A.10.32.22 miscompiles that. */ - if (SYMBOLP (charset_symbol) - && VECTORP (val = Fget (charset_symbol, Qcharset)) - && CHARSET_VALID_P (charset = - XINT (XVECTOR (val)->contents[CHARSET_ID_IDX]))) - return charset; - else - return -1; + int i; + + args[charset_arg_name] = name; + args[charset_arg_dimension] = make_number (dimension); + val = Fmake_vector (make_number (8), make_number (0)); + for (i = 0; i < 8; i++) + ASET (val, i, make_number (code_space[i])); + args[charset_arg_code_space] = val; + args[charset_arg_min_code] = make_number (min_code); + args[charset_arg_max_code] = make_number (max_code); + args[charset_arg_iso_final] + = (iso_final < 0 ? Qnil : make_number (iso_final)); + args[charset_arg_iso_revision] = make_number (iso_revision); + args[charset_arg_emacs_mule_id] + = (emacs_mule_id < 0 ? Qnil : make_number (emacs_mule_id)); + args[charset_arg_ascii_compatible_p] = ascii_compatible ? Qt : Qnil; + args[charset_arg_supplementary_p] = supplementary ? Qt : Qnil; + args[charset_arg_invalid_code] = Qnil; + args[charset_arg_code_offset] = make_number (code_offset); + args[charset_arg_map] = Qnil; + args[charset_arg_subset] = Qnil; + args[charset_arg_superset] = Qnil; + args[charset_arg_unify_map] = Qnil; + + plist[0] = intern (":name"); + plist[1] = args[charset_arg_name]; + plist[2] = intern (":dimension"); + plist[3] = args[charset_arg_dimension]; + plist[4] = intern (":code-space"); + plist[5] = args[charset_arg_code_space]; + plist[6] = intern (":iso-final-char"); + plist[7] = args[charset_arg_iso_final]; + plist[8] = intern (":emacs-mule-id"); + plist[9] = args[charset_arg_emacs_mule_id]; + plist[10] = intern (":ascii-compatible-p"); + plist[11] = args[charset_arg_ascii_compatible_p]; + plist[12] = intern (":code-offset"); + plist[13] = args[charset_arg_code_offset]; + + args[charset_arg_plist] = Flist (14, plist); + Fdefine_charset_internal (charset_arg_max, args); + + return XINT (CHARSET_SYMBOL_ID (name)); } -/* Return an identification number for a new private charset of - DIMENSION and WIDTH. If there's no more room for the new charset, - return 0. */ -Lisp_Object -get_new_private_charset_id (dimension, width) - int dimension, width; + +DEFUN ("define-charset-alias", Fdefine_charset_alias, + Sdefine_charset_alias, 2, 2, 0, + doc: /* Define ALIAS as an alias for charset CHARSET. */) + (alias, charset) + Lisp_Object alias, charset; { - int charset, from, to; + Lisp_Object attr; - if (dimension == 1) - { - from = LEADING_CODE_EXT_11; - to = LEADING_CODE_EXT_21; - } - else + CHECK_CHARSET_GET_ATTR (charset, attr); + Fputhash (alias, attr, Vcharset_hash_table); + Vcharset_list = Fcons (alias, Vcharset_list); + return Qnil; +} + + +DEFUN ("unibyte-charset", Funibyte_charset, Sunibyte_charset, 0, 0, 0, + doc: /* Return the unibyte charset (set by `set-unibyte-charset'). */) + () +{ + return CHARSET_NAME (CHARSET_FROM_ID (charset_unibyte)); +} + + +DEFUN ("set-unibyte-charset", Fset_unibyte_charset, Sset_unibyte_charset, + 1, 1, 0, + doc: /* Set the unibyte charset to CHARSET. +This determines how unibyte/multibyte conversion is done. See also +function `unibyte-charset'. */) + (charset) + Lisp_Object charset; +{ + struct charset *cs; + int i, c; + + CHECK_CHARSET_GET_CHARSET (charset, cs); + if (! cs->ascii_compatible_p + || cs->dimension != 1) + error ("Inappropriate unibyte charset: %s", SDATA (SYMBOL_NAME (charset))); + charset_unibyte = cs->id; + memset (unibyte_has_multibyte_table, 1, 128); + for (i = 128; i < 256; i++) { - from = LEADING_CODE_EXT_21; - to = LEADING_CODE_EXT_MAX + 1; + c = DECODE_CHAR (cs, i); + unibyte_to_multibyte_table[i] = (c < 0 ? BYTE8_TO_CHAR (i) : c); + unibyte_has_multibyte_table[i] = c >= 0; } - for (charset = from; charset < to; charset++) - if (!CHARSET_DEFINED_P (charset)) break; + return Qnil; +} + - return make_number (charset < to ? charset : 0); +DEFUN ("charset-plist", Fcharset_plist, Scharset_plist, 1, 1, 0, + doc: /* Return the property list of CHARSET. */) + (charset) + Lisp_Object charset; +{ + Lisp_Object attrs; + + CHECK_CHARSET_GET_ATTR (charset, attrs); + return CHARSET_ATTR_PLIST (attrs); } -DEFUN ("define-charset", Fdefine_charset, Sdefine_charset, 3, 3, 0, - doc: /* Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR. -If CHARSET-ID is nil, it is decided automatically, which means CHARSET is - treated as a private charset. -INFO-VECTOR is a vector of the format: - [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE - SHORT-NAME LONG-NAME DESCRIPTION] -The meanings of each elements is as follows: -DIMENSION (integer) is the number of bytes to represent a character: 1 or 2. -CHARS (integer) is the number of characters in a dimension: 94 or 96. -WIDTH (integer) is the number of columns a character in the charset -occupies on the screen: one of 0, 1, and 2. - -DIRECTION (integer) is the rendering direction of characters in the -charset when rendering. If 0, render from left to right, else -render from right to left. - -ISO-FINAL-CHAR (character) is the final character of the -corresponding ISO 2022 charset. -It may be -1 if the charset is internal use only. - -ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked -while encoding to variants of ISO 2022 coding system, one of the -following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR). -It may be -1 if the charset is internal use only. - -SHORT-NAME (string) is the short name to refer to the charset. - -LONG-NAME (string) is the long name to refer to the charset. - -DESCRIPTION (string) is the description string of the charset. */) - (charset_id, charset_symbol, info_vector) - Lisp_Object charset_id, charset_symbol, info_vector; + +DEFUN ("set-charset-plist", Fset_charset_plist, Sset_charset_plist, 2, 2, 0, + doc: /* Set CHARSET's property list to PLIST. */) + (charset, plist) + Lisp_Object charset, plist; { - Lisp_Object *vec; - - if (!NILP (charset_id)) - CHECK_NUMBER (charset_id); - CHECK_SYMBOL (charset_symbol); - CHECK_VECTOR (info_vector); - - if (! NILP (charset_id)) - { - if (! CHARSET_VALID_P (XINT (charset_id))) - error ("Invalid CHARSET: %d", XINT (charset_id)); - else if (CHARSET_DEFINED_P (XINT (charset_id))) - error ("Already defined charset: %d", XINT (charset_id)); - } - - vec = XVECTOR (info_vector)->contents; - if (XVECTOR (info_vector)->size != 9 - || !INTEGERP (vec[0]) || !(XINT (vec[0]) == 1 || XINT (vec[0]) == 2) - || !INTEGERP (vec[1]) || !(XINT (vec[1]) == 94 || XINT (vec[1]) == 96) - || !INTEGERP (vec[2]) || !(XINT (vec[2]) == 1 || XINT (vec[2]) == 2) - || !INTEGERP (vec[3]) || !(XINT (vec[3]) == 0 || XINT (vec[3]) == 1) - || !INTEGERP (vec[4]) - || !(XINT (vec[4]) == -1 || (XINT (vec[4]) >= '0' && XINT (vec[4]) <= '~')) - || !INTEGERP (vec[5]) - || !(XINT (vec[5]) == -1 || XINT (vec[5]) == 0 || XINT (vec[5]) == 1) - || !STRINGP (vec[6]) - || !STRINGP (vec[7]) - || !STRINGP (vec[8])) - error ("Invalid info-vector argument for defining charset %s", - SDATA (SYMBOL_NAME (charset_symbol))); - - if (NILP (charset_id)) - { - charset_id = get_new_private_charset_id (XINT (vec[0]), XINT (vec[2])); - if (XINT (charset_id) == 0) - error ("There's no room for a new private charset %s", - SDATA (SYMBOL_NAME (charset_symbol))); - } - - update_charset_table (charset_id, vec[0], vec[1], vec[2], vec[3], - vec[4], vec[5], vec[6], vec[7], vec[8]); - Fput (charset_symbol, Qcharset, CHARSET_TABLE_ENTRY (XINT (charset_id))); - CHARSET_SYMBOL (XINT (charset_id)) = charset_symbol; - Vcharset_list = Fcons (charset_symbol, Vcharset_list); - Fupdate_coding_systems_internal (); - return Qnil; + Lisp_Object attrs; + + CHECK_CHARSET_GET_ATTR (charset, attrs); + CHARSET_ATTR_PLIST (attrs) = plist; + return plist; } -DEFUN ("generic-character-list", Fgeneric_character_list, - Sgeneric_character_list, 0, 0, 0, - doc: /* Return a list of all possible generic characters. -It includes a generic character for a charset not yet defined. */) - () + +DEFUN ("unify-charset", Funify_charset, Sunify_charset, 1, 3, 0, + doc: /* Unify characters of CHARSET with Unicode. +This means reading the relevant file and installing the table defined +by CHARSET's `:unify-map' property. + +Optional second arg UNIFY-MAP is a file name string or a vector. It has +the same meaning as the `:unify-map' attribute in the function +`define-charset' (which see). + +Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */) + (charset, unify_map, deunify) + Lisp_Object charset, unify_map, deunify; { - return Vgeneric_character_list; + int id; + struct charset *cs; + + CHECK_CHARSET_GET_ID (charset, id); + cs = CHARSET_FROM_ID (id); + if (CHARSET_METHOD (cs) == CHARSET_METHOD_MAP_DEFERRED) + load_charset (cs); + if (NILP (deunify) + ? CHARSET_UNIFIED_P (cs) && ! NILP (CHARSET_DEUNIFIER (cs)) + : ! CHARSET_UNIFIED_P (cs)) + return Qnil; + + CHARSET_UNIFIED_P (cs) = 0; + if (NILP (deunify)) + { + if (CHARSET_METHOD (cs) != CHARSET_METHOD_OFFSET) + error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset))); + if (NILP (unify_map)) + unify_map = CHARSET_UNIFY_MAP (cs); + if (STRINGP (unify_map)) + load_charset_map_from_file (cs, unify_map, 2); + else if (VECTORP (unify_map)) + load_charset_map_from_vector (cs, unify_map, 2); + else if (NILP (unify_map)) + error ("No unify-map for charset"); + else + error ("Bad unify-map arg"); + CHARSET_UNIFIED_P (cs) = 1; + } + else if (CHAR_TABLE_P (Vchar_unify_table)) + { + int min_code = CHARSET_MIN_CODE (cs); + int max_code = CHARSET_MAX_CODE (cs); + int min_char = DECODE_CHAR (cs, min_code); + int max_char = DECODE_CHAR (cs, max_code); + + char_table_set_range (Vchar_unify_table, min_char, max_char, Qnil); + } + + return Qnil; } DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char, Sget_unused_iso_final_char, 2, 2, 0, - doc: /* Return an unused ISO's final char for a charset of DIMENSION and CHARS. + doc: /* +Return an unused ISO final char for a charset of DIMENISION and CHARS. DIMENSION is the number of bytes to represent a character: 1 or 2. CHARS is the number of characters in a dimension: 94 or 96. @@ -750,20 +1282,33 @@ return nil. */) CHECK_NUMBER (dimension); CHECK_NUMBER (chars); - if (XINT (dimension) != 1 && XINT (dimension) != 2) - error ("Invalid charset dimension %d, it should be 1 or 2", - XINT (dimension)); + if (XINT (dimension) != 1 && XINT (dimension) != 2 && XINT (dimension) != 3) + args_out_of_range_3 (dimension, make_number (1), make_number (3)); if (XINT (chars) != 94 && XINT (chars) != 96) - error ("Invalid charset chars %d, it should be 94 or 96", - XINT (chars)); + args_out_of_range_3 (chars, make_number (94), make_number (96)); for (final_char = '0'; final_char <= '?'; final_char++) - { - if (ISO_CHARSET_TABLE (dimension, chars, make_number (final_char)) < 0) - break; - } + if (ISO_CHARSET_TABLE (XINT (dimension), XINT (chars), final_char) < 0) + break; return (final_char <= '?' ? make_number (final_char) : Qnil); } +static void +check_iso_charset_parameter (dimension, chars, final_char) + Lisp_Object dimension, chars, final_char; +{ + CHECK_NATNUM (dimension); + CHECK_NATNUM (chars); + CHECK_NATNUM (final_char); + + if (XINT (dimension) > 3) + error ("Invalid DIMENSION %d, it should be 1, 2, or 3", XINT (dimension)); + if (XINT (chars) != 94 && XINT (chars) != 96) + error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars)); + if (XINT (final_char) < '0' || XINT (final_char) > '~') + error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars)); +} + + DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset, 4, 4, 0, doc: /* Declare an equivalent charset for ISO-2022 decoding. @@ -774,104 +1319,96 @@ if CHARSET is designated instead. */) (dimension, chars, final_char, charset) Lisp_Object dimension, chars, final_char, charset; { - int charset_id; - - CHECK_NUMBER (dimension); - CHECK_NUMBER (chars); - CHECK_NUMBER (final_char); - CHECK_SYMBOL (charset); - - if (XINT (dimension) != 1 && XINT (dimension) != 2) - error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension)); - if (XINT (chars) != 94 && XINT (chars) != 96) - error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars)); - if (XINT (final_char) < '0' || XFASTINT (final_char) > '~') - error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars)); - if ((charset_id = get_charset_id (charset)) < 0) - error ("Invalid charset %s", SDATA (SYMBOL_NAME (charset))); + int id; + int chars_flag; - ISO_CHARSET_TABLE (dimension, chars, final_char) = charset_id; + CHECK_CHARSET_GET_ID (charset, id); + check_iso_charset_parameter (dimension, chars, final_char); + chars_flag = XINT (chars) == 96; + ISO_CHARSET_TABLE (XINT (dimension), chars_flag, XINT (final_char)) = id; return Qnil; } + /* Return information about charsets in the text at PTR of NBYTES bytes, which are NCHARS characters. The value is: 0: Each character is represented by one byte. This is always - true for unibyte text. - 1: No charsets other than ascii eight-bit-control, - eight-bit-graphic, and latin-1 are found. - 2: Otherwise. + true for a unibyte string. For a multibyte string, true if + it contains only ASCII characters. + + 1: No charsets other than ascii, control-1, and latin-1 are + found. - In addition, if CHARSETS is nonzero, for each found charset N, set - CHARSETS[N] to 1. For that, callers should allocate CHARSETS - (MAX_CHARSET + 1 elements) in advance. It may lookup a translation - table TABLE if supplied. For invalid charsets, set CHARSETS[1] to - 1 (note that there's no charset whose ID is 1). */ + 2: Otherwise. +*/ int -find_charset_in_text (ptr, nchars, nbytes, charsets, table) - const unsigned char *ptr; - int nchars, nbytes, *charsets; - Lisp_Object table; +string_xstring_p (string) + Lisp_Object string; { - if (nchars == nbytes) - { - if (charsets && nbytes > 0) - { - const unsigned char *endp = ptr + nbytes; - int maskbits = 0; + const unsigned char *p = SDATA (string); + const unsigned char *endp = p + SBYTES (string); - while (ptr < endp && maskbits != 7) - { - maskbits |= (*ptr < 0x80 ? 1 : *ptr < 0xA0 ? 2 : 4); - ptr++; - } + if (SCHARS (string) == SBYTES (string)) + return 0; - if (maskbits & 1) - charsets[CHARSET_ASCII] = 1; - if (maskbits & 2) - charsets[CHARSET_8_BIT_CONTROL] = 1; - if (maskbits & 4) - charsets[CHARSET_8_BIT_GRAPHIC] = 1; - } - return 0; - } - else + while (p < endp) { - int return_val = 1; - int bytes, charset, c1, c2; + int c = STRING_CHAR_ADVANCE (p); - if (! CHAR_TABLE_P (table)) - table = Qnil; + if (c >= 0x100) + return 2; + } + return 1; +} - while (nchars-- > 0) - { - SPLIT_MULTIBYTE_SEQ (ptr, len, bytes, charset, c1, c2); - ptr += bytes; - if (!CHARSET_DEFINED_P (charset)) - charset = 1; - else if (! NILP (table)) - { - int c = translate_char (table, -1, charset, c1, c2); - if (c >= 0) - charset = CHAR_CHARSET (c); - } +/* Find charsets in the string at PTR of NCHARS and NBYTES. - if (return_val == 1 - && charset != CHARSET_ASCII - && charset != CHARSET_8_BIT_CONTROL - && charset != CHARSET_8_BIT_GRAPHIC - && charset != charset_latin_iso8859_1) - return_val = 2; + CHARSETS is a vector. If Nth element is non-nil, it means the + charset whose id is N is already found. - if (charsets) - charsets[charset] = 1; - else if (return_val == 2) - break; + It may lookup a translation table TABLE if supplied. */ + +static void +find_charsets_in_text (ptr, nchars, nbytes, charsets, table, multibyte) + const unsigned char *ptr; + EMACS_INT nchars, nbytes; + Lisp_Object charsets, table; + int multibyte; +{ + const unsigned char *pend = ptr + nbytes; + + if (nchars == nbytes) + { + if (multibyte) + ASET (charsets, charset_ascii, Qt); + else + while (ptr < pend) + { + int c = *ptr++; + + if (!NILP (table)) + c = translate_char (table, c); + if (ASCII_BYTE_P (c)) + ASET (charsets, charset_ascii, Qt); + else + ASET (charsets, charset_eight_bit, Qt); + } + } + else + { + while (ptr < pend) + { + int c = STRING_CHAR_ADVANCE (ptr); + struct charset *charset; + + if (!NILP (table)) + c = translate_char (table, c); + charset = CHAR_CHARSET (c); + ASET (charsets, CHARSET_ID (charset), Qt); } - return return_val; } } @@ -881,17 +1418,16 @@ DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region, BEG and END are buffer positions. Optional arg TABLE if non-nil is a translation table to look up. -If the region contains invalid multibyte characters, -`unknown' is included in the returned list. - If the current buffer is unibyte, the returned list may contain only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) (beg, end, table) Lisp_Object beg, end, table; { - int charsets[MAX_CHARSET + 1]; - int from, from_byte, to, stop, stop_byte, i; + Lisp_Object charsets; + EMACS_INT from, from_byte, to, stop, stop_byte; + int i; Lisp_Object val; + int multibyte = ! NILP (current_buffer->enable_multibyte_characters); validate_region (&beg, &end); from = XFASTINT (beg); @@ -907,11 +1443,12 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) from_byte = CHAR_TO_BYTE (from); - bzero (charsets, (MAX_CHARSET + 1) * sizeof (int)); + charsets = Fmake_vector (make_number (charset_table_used), Qnil); while (1) { - find_charset_in_text (BYTE_POS_ADDR (from_byte), stop - from, - stop_byte - from_byte, charsets, table); + find_charsets_in_text (BYTE_POS_ADDR (from_byte), stop - from, + stop_byte - from_byte, charsets, table, + multibyte); if (stop < to) { from = stop, from_byte = stop_byte; @@ -922,13 +1459,9 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) } val = Qnil; - if (charsets[1]) - val = Fcons (Qunknown, val); - for (i = MAX_CHARSET; i >= MIN_CHARSET_OFFICIAL_DIMENSION1; i--) - if (charsets[i]) - val = Fcons (CHARSET_SYMBOL (i), val); - if (charsets[0]) - val = Fcons (Qascii, val); + for (i = charset_table_used - 1; i >= 0; i--) + if (!NILP (AREF (charsets, i))) + val = Fcons (CHARSET_NAME (charset_table + i), val); return val; } @@ -937,850 +1470,607 @@ DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string, doc: /* Return a list of charsets in STR. Optional arg TABLE if non-nil is a translation table to look up. -If the string contains invalid multibyte characters, -`unknown' is included in the returned list. - If STR is unibyte, the returned list may contain -only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) +only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) (str, table) Lisp_Object str, table; { - int charsets[MAX_CHARSET + 1]; + Lisp_Object charsets; int i; Lisp_Object val; CHECK_STRING (str); - bzero (charsets, (MAX_CHARSET + 1) * sizeof (int)); - find_charset_in_text (SDATA (str), SCHARS (str), - SBYTES (str), charsets, table); - + charsets = Fmake_vector (make_number (charset_table_used), Qnil); + find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str), + charsets, table, + STRING_MULTIBYTE (str)); val = Qnil; - if (charsets[1]) - val = Fcons (Qunknown, val); - for (i = MAX_CHARSET; i >= MIN_CHARSET_OFFICIAL_DIMENSION1; i--) - if (charsets[i]) - val = Fcons (CHARSET_SYMBOL (i), val); - if (charsets[0]) - val = Fcons (Qascii, val); + for (i = charset_table_used - 1; i >= 0; i--) + if (!NILP (AREF (charsets, i))) + val = Fcons (CHARSET_NAME (charset_table + i), val); return val; } -DEFUN ("make-char-internal", Fmake_char_internal, Smake_char_internal, 1, 3, 0, - doc: /* Return a character made from arguments. -Internal use only. */) - (charset, code1, code2) - Lisp_Object charset, code1, code2; + +/* Return a character correponding to the code-point CODE of + CHARSET. */ + +int +decode_char (charset, code) + struct charset *charset; + unsigned code; { - int charset_id, c1, c2; + int c, char_index; + enum charset_method method = CHARSET_METHOD (charset); - CHECK_NUMBER (charset); - charset_id = XINT (charset); - if (!CHARSET_DEFINED_P (charset_id)) - error ("Invalid charset ID: %d", XINT (charset)); + if (code < CHARSET_MIN_CODE (charset) || code > CHARSET_MAX_CODE (charset)) + return -1; - if (NILP (code1)) - c1 = 0; - else + if (method == CHARSET_METHOD_MAP_DEFERRED) { - CHECK_NUMBER (code1); - c1 = XINT (code1); - } - if (NILP (code2)) - c2 = 0; - else - { - CHECK_NUMBER (code2); - c2 = XINT (code2); + load_charset (charset); + method = CHARSET_METHOD (charset); } - if (charset_id == CHARSET_ASCII) + if (method == CHARSET_METHOD_SUBSET) { - if (c1 < 0 || c1 > 0x7F) - goto invalid_code_posints; - return make_number (c1); + Lisp_Object subset_info; + + subset_info = CHARSET_SUBSET (charset); + charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0))); + code -= XINT (AREF (subset_info, 3)); + if (code < XFASTINT (AREF (subset_info, 1)) + || code > XFASTINT (AREF (subset_info, 2))) + c = -1; + else + c = DECODE_CHAR (charset, code); } - else if (charset_id == CHARSET_8_BIT_CONTROL) + else if (method == CHARSET_METHOD_SUPERSET) { - if (NILP (code1)) - c1 = 0x80; - else if (c1 < 0x80 || c1 > 0x9F) - goto invalid_code_posints; - return make_number (c1); + Lisp_Object parents; + + parents = CHARSET_SUPERSET (charset); + c = -1; + for (; CONSP (parents); parents = XCDR (parents)) + { + int id = XINT (XCAR (XCAR (parents))); + int code_offset = XINT (XCDR (XCAR (parents))); + unsigned this_code = code - code_offset; + + charset = CHARSET_FROM_ID (id); + if ((c = DECODE_CHAR (charset, this_code)) >= 0) + break; + } } - else if (charset_id == CHARSET_8_BIT_GRAPHIC) + else { - if (NILP (code1)) - c1 = 0xA0; - else if (c1 < 0xA0 || c1 > 0xFF) - goto invalid_code_posints; - return make_number (c1); - } - else if (c1 < 0 || c1 > 0xFF || c2 < 0 || c2 > 0xFF) - goto invalid_code_posints; - c1 &= 0x7F; - c2 &= 0x7F; - if (c1 == 0 - ? c2 != 0 - : (c2 == 0 - ? !CHAR_COMPONENTS_VALID_P (charset_id, c1, 0x20) - : !CHAR_COMPONENTS_VALID_P (charset_id, c1, c2))) - goto invalid_code_posints; - return make_number (MAKE_CHAR (charset_id, c1, c2)); - - invalid_code_posints: - error ("Invalid code points for charset ID %d: %d %d", charset_id, c1, c2); -} + char_index = CODE_POINT_TO_INDEX (charset, code); + if (char_index < 0) + return -1; -DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0, - doc: /* Return list of charset and one or two position-codes of CH. -If CH is invalid as a character code, -return a list of symbol `unknown' and CH. */) - (ch) - Lisp_Object ch; -{ - int c, charset, c1, c2; + if (method == CHARSET_METHOD_MAP) + { + Lisp_Object decoder; - CHECK_NUMBER (ch); - c = XFASTINT (ch); - if (!CHAR_VALID_P (c, 1)) - return Fcons (Qunknown, Fcons (ch, Qnil)); - SPLIT_CHAR (XFASTINT (ch), charset, c1, c2); - return (c2 >= 0 - ? Fcons (CHARSET_SYMBOL (charset), - Fcons (make_number (c1), Fcons (make_number (c2), Qnil))) - : Fcons (CHARSET_SYMBOL (charset), Fcons (make_number (c1), Qnil))); -} + decoder = CHARSET_DECODER (charset); + if (! VECTORP (decoder)) + return -1; + c = XINT (AREF (decoder, char_index)); + } + else + { + c = char_index + CHARSET_CODE_OFFSET (charset); + } + } -DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0, - doc: /* Return charset of CH. */) - (ch) - Lisp_Object ch; -{ - CHECK_NUMBER (ch); + if (CHARSET_UNIFIED_P (charset) + && c >= 0) + { + MAYBE_UNIFY_CHAR (c); + } - return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch))); + return c; } -DEFUN ("charset-after", Fcharset_after, Scharset_after, 0, 1, 0, - doc: /* Return charset of a character in the current buffer at position POS. -If POS is nil, it defauls to the current point. -If POS is out of range, the value is nil. */) - (pos) - Lisp_Object pos; -{ - Lisp_Object ch; - int charset; +/* Variable used temporarily by the macro ENCODE_CHAR. */ +Lisp_Object charset_work; - ch = Fchar_after (pos); - if (! INTEGERP (ch)) - return ch; - charset = CHAR_CHARSET (XINT (ch)); - return CHARSET_SYMBOL (charset); -} - -DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0, - doc: /* Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR. +/* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to + CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true, + use CHARSET's strict_max_char instead of max_char. */ -ISO 2022's designation sequence (escape sequence) distinguishes charsets -by their DIMENSION, CHARS, and FINAL-CHAR, -where as Emacs distinguishes them by charset symbol. -See the documentation of the function `charset-info' for the meanings of -DIMENSION, CHARS, and FINAL-CHAR. */) - (dimension, chars, final_char) - Lisp_Object dimension, chars, final_char; -{ - int charset; - - CHECK_NUMBER (dimension); - CHECK_NUMBER (chars); - CHECK_NUMBER (final_char); - - if ((charset = ISO_CHARSET_TABLE (dimension, chars, final_char)) < 0) - return Qnil; - return CHARSET_SYMBOL (charset); -} - -/* If GENERICP is nonzero, return nonzero if C is a valid normal or - generic character. If GENERICP is zero, return nonzero if C is a - valid normal character. Do not call this function directly, - instead use macro CHAR_VALID_P. */ -int -char_valid_p (c, genericp) - int c, genericp; +unsigned +encode_char (charset, c) + struct charset *charset; + int c; { - int charset, c1, c2; + unsigned code; + enum charset_method method = CHARSET_METHOD (charset); - if (c < 0 || c >= MAX_CHAR) - return 0; - if (SINGLE_BYTE_CHAR_P (c)) - return 1; - SPLIT_CHAR (c, charset, c1, c2); - if (genericp) + if (CHARSET_UNIFIED_P (charset)) { - if (c1) - { - if (c2 <= 0) c2 = 0x20; - } - else + Lisp_Object deunifier, deunified; + + deunifier = CHARSET_DEUNIFIER (charset); + if (! CHAR_TABLE_P (deunifier)) { - if (c2 <= 0) c1 = c2 = 0x20; + Funify_charset (CHARSET_NAME (charset), Qnil, Qnil); + deunifier = CHARSET_DEUNIFIER (charset); } + deunified = CHAR_TABLE_REF (deunifier, c); + if (! NILP (deunified)) + c = XINT (deunified); } - return (CHARSET_DEFINED_P (charset) - && CHAR_COMPONENTS_VALID_P (charset, c1, c2)); -} -DEFUN ("char-valid-p", Fchar_valid_p, Schar_valid_p, 1, 2, 0, - doc: /* Return t if OBJECT is a valid normal character. -If optional arg GENERICP is non-nil, also return t if OBJECT is -a valid generic character. */) - (object, genericp) - Lisp_Object object, genericp; -{ - if (! NATNUMP (object)) - return Qnil; - return (CHAR_VALID_P (XFASTINT (object), !NILP (genericp)) ? Qt : Qnil); -} + if (method == CHARSET_METHOD_SUBSET) + { + Lisp_Object subset_info; + struct charset *this_charset; + + subset_info = CHARSET_SUBSET (charset); + this_charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0))); + code = ENCODE_CHAR (this_charset, c); + if (code == CHARSET_INVALID_CODE (this_charset) + || code < XFASTINT (AREF (subset_info, 1)) + || code > XFASTINT (AREF (subset_info, 2))) + return CHARSET_INVALID_CODE (charset); + code += XINT (AREF (subset_info, 3)); + return code; + } -DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte, - Sunibyte_char_to_multibyte, 1, 1, 0, - doc: /* Convert the unibyte character CH to multibyte character. -The conversion is done based on `nonascii-translation-table' (which see) - or `nonascii-insert-offset' (which see). */) - (ch) - Lisp_Object ch; -{ - int c; + if (method == CHARSET_METHOD_SUPERSET) + { + Lisp_Object parents; - CHECK_NUMBER (ch); - c = XINT (ch); - if (c < 0 || c >= 0400) - error ("Invalid unibyte character: %d", c); - c = unibyte_char_to_multibyte (c); - if (c < 0) - error ("Can't convert to multibyte character: %d", XINT (ch)); - return make_number (c); -} + parents = CHARSET_SUPERSET (charset); + for (; CONSP (parents); parents = XCDR (parents)) + { + int id = XINT (XCAR (XCAR (parents))); + int code_offset = XINT (XCDR (XCAR (parents))); + struct charset *this_charset = CHARSET_FROM_ID (id); -DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte, - Smultibyte_char_to_unibyte, 1, 1, 0, - doc: /* Convert the multibyte character CH to unibyte character. -The conversion is done based on `nonascii-translation-table' (which see) - or `nonascii-insert-offset' (which see). */) - (ch) - Lisp_Object ch; -{ - int c; + code = ENCODE_CHAR (this_charset, c); + if (code != CHARSET_INVALID_CODE (this_charset)) + return code + code_offset; + } + return CHARSET_INVALID_CODE (charset); + } - CHECK_NUMBER (ch); - c = XINT (ch); - if (! CHAR_VALID_P (c, 0)) - error ("Invalid multibyte character: %d", c); - c = multibyte_char_to_unibyte (c, Qnil); - if (c < 0) - error ("Can't convert to unibyte character: %d", XINT (ch)); - return make_number (c); -} + if (! CHARSET_FAST_MAP_REF ((c), charset->fast_map) + || c < CHARSET_MIN_CHAR (charset) || c > CHARSET_MAX_CHAR (charset)) + return CHARSET_INVALID_CODE (charset); -DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0, - doc: /* Return 1 regardless of the argument CH. */) - (ch) - Lisp_Object ch; -{ - CHECK_NUMBER (ch); - return make_number (1); -} + if (method == CHARSET_METHOD_MAP_DEFERRED) + { + load_charset (charset); + method = CHARSET_METHOD (charset); + } -/* Return how many bytes C will occupy in a multibyte buffer. - Don't call this function directly, instead use macro CHAR_BYTES. */ -int -char_bytes (c) - int c; -{ - int charset; + if (method == CHARSET_METHOD_MAP) + { + Lisp_Object encoder; + Lisp_Object val; - if (ASCII_BYTE_P (c) || (c & ~((1 << CHARACTERBITS) -1))) - return 1; - if (SINGLE_BYTE_CHAR_P (c) && c >= 0xA0) - return 1; + encoder = CHARSET_ENCODER (charset); + if (! CHAR_TABLE_P (CHARSET_ENCODER (charset))) + return CHARSET_INVALID_CODE (charset); + val = CHAR_TABLE_REF (encoder, c); + if (NILP (val)) + return CHARSET_INVALID_CODE (charset); + code = XINT (val); + if (! CHARSET_COMPACT_CODES_P (charset)) + code = INDEX_TO_CODE_POINT (charset, code); + } + else /* method == CHARSET_METHOD_OFFSET */ + { + code = c - CHARSET_CODE_OFFSET (charset); + code = INDEX_TO_CODE_POINT (charset, code); + } - charset = CHAR_CHARSET (c); - return (CHARSET_DEFINED_P (charset) ? CHARSET_BYTES (charset) : 1); + return code; } -/* Return the width of character of which multi-byte form starts with - C. The width is measured by how many columns occupied on the - screen when displayed in the current buffer. */ - -#define ONE_BYTE_CHAR_WIDTH(c) \ - (c < 0x20 \ - ? (c == '\t' \ - ? XFASTINT (current_buffer->tab_width) \ - : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \ - : (c < 0x7f \ - ? 1 \ - : (c == 0x7F \ - ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \ - : ((! NILP (current_buffer->enable_multibyte_characters) \ - && BASE_LEADING_CODE_P (c)) \ - ? WIDTH_BY_CHAR_HEAD (c) \ - : 4)))) - -DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0, - doc: /* Return width of CH when displayed in the current buffer. -The width is measured by how many columns it occupies on the screen. -Tab is taken to occupy `tab-width' columns. */) - (ch) - Lisp_Object ch; -{ - Lisp_Object val, disp; - int c; - struct Lisp_Char_Table *dp = buffer_display_table (); - CHECK_NUMBER (ch); +DEFUN ("decode-char", Fdecode_char, Sdecode_char, 2, 3, 0, + doc: /* Decode the pair of CHARSET and CODE-POINT into a character. +Return nil if CODE-POINT is not valid in CHARSET. - c = XINT (ch); +CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). - /* Get the way the display table would display it. */ - disp = dp ? DISP_CHAR_VECTOR (dp, c) : Qnil; +Optional argument RESTRICTION specifies a way to map the pair of CCS +and CODE-POINT to a chracter. Currently not supported and just ignored. */) + (charset, code_point, restriction) + Lisp_Object charset, code_point, restriction; +{ + int c, id; + unsigned code; + struct charset *charsetp; - if (VECTORP (disp)) - XSETINT (val, XVECTOR (disp)->size); - else if (SINGLE_BYTE_CHAR_P (c)) - XSETINT (val, ONE_BYTE_CHAR_WIDTH (c)); + CHECK_CHARSET_GET_ID (charset, id); + if (CONSP (code_point)) + { + CHECK_NATNUM_CAR (code_point); + CHECK_NATNUM_CDR (code_point); + code = (XINT (XCAR (code_point)) << 16) | (XINT (XCDR (code_point))); + } else { - int charset = CHAR_CHARSET (c); - - XSETFASTINT (val, CHARSET_WIDTH (charset)); + CHECK_NATNUM (code_point); + code = XINT (code_point); } - return val; + charsetp = CHARSET_FROM_ID (id); + c = DECODE_CHAR (charsetp, code); + return (c >= 0 ? make_number (c) : Qnil); } -/* Return width of string STR of length LEN when displayed in the - current buffer. The width is measured by how many columns it - occupies on the screen. */ -int -strwidth (str, len) - unsigned char *str; - int len; +DEFUN ("encode-char", Fencode_char, Sencode_char, 2, 3, 0, + doc: /* Encode the character CH into a code-point of CHARSET. +Return nil if CHARSET doesn't include CH. + +Optional argument RESTRICTION specifies a way to map CHAR to a +code-point in CCS. Currently not supported and just ignored. */) + (ch, charset, restriction) + Lisp_Object ch, charset, restriction; { - return c_string_width (str, len, -1, NULL, NULL); + int id; + unsigned code; + struct charset *charsetp; + + CHECK_CHARSET_GET_ID (charset, id); + CHECK_NATNUM (ch); + charsetp = CHARSET_FROM_ID (id); + code = ENCODE_CHAR (charsetp, XINT (ch)); + if (code == CHARSET_INVALID_CODE (charsetp)) + return Qnil; + if (code > 0x7FFFFFF) + return Fcons (make_number (code >> 16), make_number (code & 0xFFFF)); + return make_number (code); } -/* Return width of string STR of length LEN when displayed in the - current buffer. The width is measured by how many columns it - occupies on the screen. If PRECISION > 0, return the width of - longest substring that doesn't exceed PRECISION, and set number of - characters and bytes of the substring in *NCHARS and *NBYTES - respectively. */ -int -c_string_width (str, len, precision, nchars, nbytes) - const unsigned char *str; - int len, precision, *nchars, *nbytes; +DEFUN ("make-char", Fmake_char, Smake_char, 1, 5, 0, + doc: + /* Return a character of CHARSET whose position codes are CODEn. + +CODE1 through CODE4 are optional, but if you don't supply sufficient +position codes, it is assumed that the minimum code in each dimension +is specified. */) + (charset, code1, code2, code3, code4) + Lisp_Object charset, code1, code2, code3, code4; { - int i = 0, i_byte = 0; - int width = 0; - int chars; - struct Lisp_Char_Table *dp = buffer_display_table (); + int id, dimension; + struct charset *charsetp; + unsigned code; + int c; + + CHECK_CHARSET_GET_ID (charset, id); + charsetp = CHARSET_FROM_ID (id); - while (i_byte < len) + dimension = CHARSET_DIMENSION (charsetp); + if (NILP (code1)) + code = (CHARSET_ASCII_COMPATIBLE_P (charsetp) + ? 0 : CHARSET_MIN_CODE (charsetp)); + else { - int bytes, thiswidth; - Lisp_Object val; + CHECK_NATNUM (code1); + if (XFASTINT (code1) >= 0x100) + args_out_of_range (make_number (0xFF), code1); + code = XFASTINT (code1); - if (dp) + if (dimension > 1) { - int c = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes); - - chars = 1; - val = DISP_CHAR_VECTOR (dp, c); - if (VECTORP (val)) - thiswidth = XVECTOR (val)->size; + code <<= 8; + if (NILP (code2)) + code |= charsetp->code_space[(dimension - 2) * 4]; else - thiswidth = ONE_BYTE_CHAR_WIDTH (str[i_byte]); - } - else - { - chars = 1; - PARSE_MULTIBYTE_SEQ (str + i_byte, len - i_byte, bytes); - thiswidth = ONE_BYTE_CHAR_WIDTH (str[i_byte]); - } + { + CHECK_NATNUM (code2); + if (XFASTINT (code2) >= 0x100) + args_out_of_range (make_number (0xFF), code2); + code |= XFASTINT (code2); + } - if (precision > 0 - && (width + thiswidth > precision)) - { - *nchars = i; - *nbytes = i_byte; - return width; + if (dimension > 2) + { + code <<= 8; + if (NILP (code3)) + code |= charsetp->code_space[(dimension - 3) * 4]; + else + { + CHECK_NATNUM (code3); + if (XFASTINT (code3) >= 0x100) + args_out_of_range (make_number (0xFF), code3); + code |= XFASTINT (code3); + } + + if (dimension > 3) + { + code <<= 8; + if (NILP (code4)) + code |= charsetp->code_space[0]; + else + { + CHECK_NATNUM (code4); + if (XFASTINT (code4) >= 0x100) + args_out_of_range (make_number (0xFF), code4); + code |= XFASTINT (code4); + } + } + } } - i++; - i_byte += bytes; - width += thiswidth; - } - - if (precision > 0) - { - *nchars = i; - *nbytes = i_byte; } - return width; + if (CHARSET_ISO_FINAL (charsetp) >= 0) + code &= 0x7F7F7F7F; + c = DECODE_CHAR (charsetp, code); + if (c < 0) + error ("Invalid code(s)"); + return make_number (c); } -/* Return width of Lisp string STRING when displayed in the current - buffer. The width is measured by how many columns it occupies on - the screen while paying attention to compositions. If PRECISION > - 0, return the width of longest substring that doesn't exceed - PRECISION, and set number of characters and bytes of the substring - in *NCHARS and *NBYTES respectively. */ -int -lisp_string_width (string, precision, nchars, nbytes) - Lisp_Object string; - int precision, *nchars, *nbytes; -{ - int len = SCHARS (string); - int len_byte = SBYTES (string); - /* This set multibyte to 0 even if STRING is multibyte when it - contains only ascii and eight-bit-graphic, but that's - intentional. */ - int multibyte = len < len_byte; - const unsigned char *str = SDATA (string); - int i = 0, i_byte = 0; - int width = 0; - struct Lisp_Char_Table *dp = buffer_display_table (); - - while (i < len) - { - int chars, bytes, thiswidth; - Lisp_Object val; - int cmp_id; - int ignore, end; +/* Return the first charset in CHARSET_LIST that contains C. + CHARSET_LIST is a list of charset IDs. If it is nil, use + Vcharset_ordered_list. */ - if (find_composition (i, -1, &ignore, &end, &val, string) - && ((cmp_id = get_composition_id (i, i_byte, end - i, val, string)) - >= 0)) - { - thiswidth = composition_table[cmp_id]->width; - chars = end - i; - bytes = string_char_to_byte (string, end) - i_byte; - } - else if (dp) - { - int c; +struct charset * +char_charset (c, charset_list, code_return) + int c; + Lisp_Object charset_list; + unsigned *code_return; +{ + if (NILP (charset_list)) + charset_list = Vcharset_ordered_list; - if (multibyte) - c = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes); - else - c = str[i_byte], bytes = 1; - chars = 1; - val = DISP_CHAR_VECTOR (dp, c); - if (VECTORP (val)) - thiswidth = XVECTOR (val)->size; - else - thiswidth = ONE_BYTE_CHAR_WIDTH (str[i_byte]); - } - else - { - chars = 1; - if (multibyte) - PARSE_MULTIBYTE_SEQ (str + i_byte, len_byte - i_byte, bytes); - else - bytes = 1; - thiswidth = ONE_BYTE_CHAR_WIDTH (str[i_byte]); - } + while (CONSP (charset_list)) + { + struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + unsigned code = ENCODE_CHAR (charset, c); - if (precision > 0 - && (width + thiswidth > precision)) + if (code != CHARSET_INVALID_CODE (charset)) { - *nchars = i; - *nbytes = i_byte; - return width; + if (code_return) + *code_return = code; + return charset; } - i += chars; - i_byte += bytes; - width += thiswidth; - } - - if (precision > 0) - { - *nchars = i; - *nbytes = i_byte; + charset_list = XCDR (charset_list); } - - return width; + return NULL; } -DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0, - doc: /* Return width of STRING when displayed in the current buffer. -Width is measured by how many columns it occupies on the screen. -When calculating width of a multibyte character in STRING, -only the base leading-code is considered; the validity of -the following bytes is not checked. Tabs in STRING are always -taken to occupy `tab-width' columns. */) - (string) - Lisp_Object string; -{ - Lisp_Object val; - - CHECK_STRING (string); - XSETFASTINT (val, lisp_string_width (string, -1, NULL, NULL)); - return val; -} -DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0, - doc: /* Return the direction of CH. -The returned value is 0 for left-to-right and 1 for right-to-left. */) +DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0, + doc: + /*Return list of charset and one to four position-codes of CHAR. +The charset is decided by the current priority order of charsets. +A position-code is a byte value of each dimension of the code-point of +CHAR in the charset. */) (ch) Lisp_Object ch; { - int charset; + struct charset *charset; + int c, dimension; + unsigned code; + Lisp_Object val; - CHECK_NUMBER (ch); - charset = CHAR_CHARSET (XFASTINT (ch)); - if (!CHARSET_DEFINED_P (charset)) - invalid_character (XINT (ch)); - return CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX); + CHECK_CHARACTER (ch); + c = XFASTINT (ch); + charset = CHAR_CHARSET (c); + if (! charset) + abort (); + code = ENCODE_CHAR (charset, c); + if (code == CHARSET_INVALID_CODE (charset)) + abort (); + dimension = CHARSET_DIMENSION (charset); + for (val = Qnil; dimension > 0; dimension--) + { + val = Fcons (make_number (code & 0xFF), val); + code >>= 8; + } + return Fcons (CHARSET_NAME (charset), val); } -/* Return the number of characters in the NBYTES bytes at PTR. - This works by looking at the contents and checking for multibyte sequences. - However, if the current buffer has enable-multibyte-characters = nil, - we treat each byte as a character. */ -int -chars_in_text (ptr, nbytes) - const unsigned char *ptr; - int nbytes; +DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0, + doc: /* Return the charset of highest priority that contains CH. */) + (ch) + Lisp_Object ch; { - /* current_buffer is null at early stages of Emacs initialization. */ - if (current_buffer == 0 - || NILP (current_buffer->enable_multibyte_characters)) - return nbytes; + struct charset *charset; - return multibyte_chars_in_text (ptr, nbytes); + CHECK_CHARACTER (ch); + charset = CHAR_CHARSET (XINT (ch)); + return (CHARSET_NAME (charset)); } -/* Return the number of characters in the NBYTES bytes at PTR. - This works by looking at the contents and checking for multibyte sequences. - It ignores enable-multibyte-characters. */ -int -multibyte_chars_in_text (ptr, nbytes) - const unsigned char *ptr; - int nbytes; +DEFUN ("charset-after", Fcharset_after, Scharset_after, 0, 1, 0, + doc: /* +Return charset of a character in the current buffer at position POS. +If POS is nil, it defauls to the current point. +If POS is out of range, the value is nil. */) + (pos) + Lisp_Object pos; { - const unsigned char *endp; - int chars, bytes; + Lisp_Object ch; + struct charset *charset; - endp = ptr + nbytes; - chars = 0; + ch = Fchar_after (pos); + if (! INTEGERP (ch)) + return ch; + charset = CHAR_CHARSET (XINT (ch)); + return (CHARSET_NAME (charset)); +} - while (ptr < endp) - { - PARSE_MULTIBYTE_SEQ (ptr, endp - ptr, bytes); - ptr += bytes; - chars++; - } - return chars; -} +DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0, + doc: /* +Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR. -/* Parse unibyte text at STR of LEN bytes as multibyte text, and - count the numbers of characters and bytes in it. On counting - bytes, pay attention to the fact that 8-bit characters in the range - 0x80..0x9F are represented by 2 bytes in multibyte text. */ -void -parse_str_as_multibyte (str, len, nchars, nbytes) - const unsigned char *str; - int len, *nchars, *nbytes; +ISO 2022's designation sequence (escape sequence) distinguishes charsets +by their DIMENSION, CHARS, and FINAL-CHAR, +where as Emacs distinguishes them by charset symbol. +See the documentation of the function `charset-info' for the meanings of +DIMENSION, CHARS, and FINAL-CHAR. */) + (dimension, chars, final_char) + Lisp_Object dimension, chars, final_char; { - const unsigned char *endp = str + len; - int n, chars = 0, bytes = 0; - - while (str < endp) - { - if (UNIBYTE_STR_AS_MULTIBYTE_P (str, endp - str, n)) - str += n, bytes += n; - else - str++, bytes += 2; - chars++; - } - *nchars = chars; - *nbytes = bytes; - return; + int id; + int chars_flag; + + check_iso_charset_parameter (dimension, chars, final_char); + chars_flag = XFASTINT (chars) == 96; + id = ISO_CHARSET_TABLE (XFASTINT (dimension), chars_flag, + XFASTINT (final_char)); + return (id >= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id)) : Qnil); } -/* Arrange unibyte text at STR of NBYTES bytes as multibyte text. - It actually converts only 8-bit characters in the range 0x80..0x9F - that don't contruct multibyte characters to multibyte forms. If - NCHARS is nonzero, set *NCHARS to the number of characters in the - text. It is assured that we can use LEN bytes at STR as a work - area and that is enough. Return the number of bytes of the - resulting text. */ -int -str_as_multibyte (str, len, nbytes, nchars) - unsigned char *str; - int len, nbytes, *nchars; +DEFUN ("clear-charset-maps", Fclear_charset_maps, Sclear_charset_maps, + 0, 0, 0, + doc: /* +Clear encoder and decoder of charsets that are loaded from mapfiles. */) + () { - unsigned char *p = str, *endp = str + nbytes; - unsigned char *to; - int chars = 0; - int n; - - while (p < endp && UNIBYTE_STR_AS_MULTIBYTE_P (p, endp - p, n)) - p += n, chars++; - if (nchars) - *nchars = chars; - if (p == endp) - return nbytes; - - to = p; - nbytes = endp - p; - endp = str + len; - safe_bcopy (p, endp - nbytes, nbytes); - p = endp - nbytes; - while (p < endp) + int i; + struct charset *charset; + Lisp_Object attrs; + + for (i = 0; i < charset_table_used; i++) { - if (UNIBYTE_STR_AS_MULTIBYTE_P (p, endp - p, n)) - { - while (n--) - *to++ = *p++; - } - else + charset = CHARSET_FROM_ID (i); + attrs = CHARSET_ATTRIBUTES (charset); + + if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP) { - *to++ = LEADING_CODE_8_BIT_CONTROL; - *to++ = *p++ + 0x20; + CHARSET_ATTR_DECODER (attrs) = Qnil; + CHARSET_ATTR_ENCODER (attrs) = Qnil; + CHARSET_METHOD (charset) = CHARSET_METHOD_MAP_DEFERRED; } - chars++; - } - if (nchars) - *nchars = chars; - return (to - str); -} -/* Parse unibyte string at STR of LEN bytes, and return the number of - bytes it may ocupy when converted to multibyte string by - `str_to_multibyte'. */ - -int -parse_str_to_multibyte (str, len) - unsigned char *str; - int len; -{ - unsigned char *endp = str + len; - int bytes; - - for (bytes = 0; str < endp; str++) - bytes += (*str < 0x80 || *str >= 0xA0) ? 1 : 2; - return bytes; -} - -/* Convert unibyte text at STR of NBYTES bytes to multibyte text - that contains the same single-byte characters. It actually - converts all 8-bit characters to multibyte forms. It is assured - that we can use LEN bytes at STR as a work area and that is - enough. */ + if (CHARSET_UNIFIED_P (charset)) + CHARSET_ATTR_DEUNIFIER (attrs) = Qnil; + } -int -str_to_multibyte (str, len, bytes) - unsigned char *str; - int len, bytes; -{ - unsigned char *p = str, *endp = str + bytes; - unsigned char *to; - - while (p < endp && (*p < 0x80 || *p >= 0xA0)) p++; - if (p == endp) - return bytes; - to = p; - bytes = endp - p; - endp = str + len; - safe_bcopy (p, endp - bytes, bytes); - p = endp - bytes; - while (p < endp) + if (CHAR_TABLE_P (Vchar_unified_charset_table)) { - if (*p < 0x80 || *p >= 0xA0) - *to++ = *p++; - else - *to++ = LEADING_CODE_8_BIT_CONTROL, *to++ = *p++ + 0x20; + Foptimize_char_table (Vchar_unified_charset_table); + Vchar_unify_table = Vchar_unified_charset_table; + Vchar_unified_charset_table = Qnil; } - return (to - str); -} -/* Arrange multibyte text at STR of LEN bytes as a unibyte text. It - actually converts only 8-bit characters in the range 0x80..0x9F to - unibyte forms. */ + return Qnil; +} -int -str_as_unibyte (str, bytes) - unsigned char *str; - int bytes; +DEFUN ("charset-priority-list", Fcharset_priority_list, + Scharset_priority_list, 0, 1, 0, + doc: /* Return the list of charsets ordered by priority. +HIGHESTP non-nil means just return the highest priority one. */) + (highestp) + Lisp_Object highestp; { - unsigned char *p = str, *endp = str + bytes; - unsigned char *to = str; + Lisp_Object val = Qnil, list = Vcharset_ordered_list; - while (p < endp && *p != LEADING_CODE_8_BIT_CONTROL) p++; - to = p; - while (p < endp) + if (!NILP (highestp)) + return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list)))); + + while (!NILP (list)) { - if (*p == LEADING_CODE_8_BIT_CONTROL) - *to++ = *(p + 1) - 0x20, p += 2; - else - *to++ = *p++; + val = Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list)))), val); + list = XCDR (list); } - return (to - str); + return Fnreverse (val); } - -DEFUN ("string", Fstring, Sstring, 0, MANY, 0, - doc: /* Concatenate all the argument characters and make the result a string. -usage: (string &rest CHARACTERS) */) - (n, args) - int n; +DEFUN ("set-charset-priority", Fset_charset_priority, Sset_charset_priority, + 1, MANY, 0, + doc: /* Assign higher priority to the charsets given as arguments. +usage: (set-charset-priority &rest charsets) */) + (nargs, args) + int nargs; Lisp_Object *args; { - int i, bufsize; - unsigned char *buf, *p; - int c; - int multibyte = 0; - Lisp_Object ret; - USE_SAFE_ALLOCA; - - bufsize = MAX_MULTIBYTE_LENGTH * n; - SAFE_ALLOCA (buf, unsigned char *, bufsize); - p = buf; + Lisp_Object new_head, old_list, arglist[2]; + Lisp_Object list_2022, list_emacs_mule; + int i, id; - for (i = 0; i < n; i++) + old_list = Fcopy_sequence (Vcharset_ordered_list); + new_head = Qnil; + for (i = 0; i < nargs; i++) { - CHECK_NUMBER (args[i]); - if (!multibyte && !SINGLE_BYTE_CHAR_P (XFASTINT (args[i]))) - multibyte = 1; + CHECK_CHARSET_GET_ID (args[i], id); + if (! NILP (Fmemq (make_number (id), old_list))) + { + old_list = Fdelq (make_number (id), old_list); + new_head = Fcons (make_number (id), new_head); + } } + arglist[0] = Fnreverse (new_head); + arglist[1] = old_list; + Vcharset_ordered_list = Fnconc (2, arglist); + charset_ordered_list_tick++; - for (i = 0; i < n; i++) + for (old_list = Vcharset_ordered_list, list_2022 = list_emacs_mule = Qnil; + CONSP (old_list); old_list = XCDR (old_list)) { - c = XINT (args[i]); - if (multibyte) - p += CHAR_STRING (c, p); - else - *p++ = c; + if (! NILP (Fmemq (XCAR (old_list), Viso_2022_charset_list))) + list_2022 = Fcons (XCAR (old_list), list_2022); + if (! NILP (Fmemq (XCAR (old_list), Vemacs_mule_charset_list))) + list_emacs_mule = Fcons (XCAR (old_list), list_emacs_mule); } + Viso_2022_charset_list = Fnreverse (list_2022); + Vemacs_mule_charset_list = Fnreverse (list_emacs_mule); - ret = make_string_from_bytes (buf, n, p - buf); - SAFE_FREE (); - - return ret; + return Qnil; } -#endif /* emacs */ - -int -charset_id_internal (charset_name) - char *charset_name; +DEFUN ("charset-id-internal", Fcharset_id_internal, Scharset_id_internal, + 0, 1, 0, + doc: /* Internal use only. +Return charset identification number of CHARSET. */) + (charset) + Lisp_Object charset; { - Lisp_Object val; - - val= Fget (intern (charset_name), Qcharset); - if (!VECTORP (val)) - error ("Charset %s is not defined", charset_name); + int id; - return (XINT (XVECTOR (val)->contents[0])); + CHECK_CHARSET_GET_ID (charset, id); + return make_number (id); } -DEFUN ("setup-special-charsets", Fsetup_special_charsets, - Ssetup_special_charsets, 0, 0, 0, doc: /* Internal use only. */) - () + +void +init_charset () { - charset_latin_iso8859_1 = charset_id_internal ("latin-iso8859-1"); - charset_jisx0208_1978 = charset_id_internal ("japanese-jisx0208-1978"); - charset_jisx0208 = charset_id_internal ("japanese-jisx0208"); - charset_katakana_jisx0201 = charset_id_internal ("katakana-jisx0201"); - charset_latin_jisx0201 = charset_id_internal ("latin-jisx0201"); - charset_big5_1 = charset_id_internal ("chinese-big5-1"); - charset_big5_2 = charset_id_internal ("chinese-big5-2"); - charset_mule_unicode_0100_24ff - = charset_id_internal ("mule-unicode-0100-24ff"); - charset_mule_unicode_2500_33ff - = charset_id_internal ("mule-unicode-2500-33ff"); - charset_mule_unicode_e000_ffff - = charset_id_internal ("mule-unicode-e000-ffff"); - return Qnil; + Vcharset_map_path + = Fcons (Fexpand_file_name (build_string ("charsets"), Vdata_directory), + Qnil); } + void init_charset_once () { int i, j, k; - staticpro (&Vcharset_table); - staticpro (&Vcharset_symbol_table); - staticpro (&Vgeneric_character_list); - - /* This has to be done here, before we call Fmake_char_table. */ - Qcharset_table = intern ("charset-table"); - staticpro (&Qcharset_table); - - /* Intern this now in case it isn't already done. - Setting this variable twice is harmless. - But don't staticpro it here--that is done in alloc.c. */ - Qchar_table_extra_slots = intern ("char-table-extra-slots"); - - /* Now we are ready to set up this property, so we can - create the charset table. */ - Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0)); - Vcharset_table = Fmake_char_table (Qcharset_table, Qnil); - - Qunknown = intern ("unknown"); - staticpro (&Qunknown); - Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET + 1), - Qunknown); - - /* Setup tables. */ - for (i = 0; i < 2; i++) - for (j = 0; j < 2; j++) - for (k = 0; k < 128; k++) - iso_charset_table [i][j][k] = -1; + for (i = 0; i < ISO_MAX_DIMENSION; i++) + for (j = 0; j < ISO_MAX_CHARS; j++) + for (k = 0; k < ISO_MAX_FINAL; k++) + iso_charset_table[i][j][k] = -1; for (i = 0; i < 256; i++) - bytes_by_char_head[i] = 1; - bytes_by_char_head[LEADING_CODE_PRIVATE_11] = 3; - bytes_by_char_head[LEADING_CODE_PRIVATE_12] = 3; - bytes_by_char_head[LEADING_CODE_PRIVATE_21] = 4; - bytes_by_char_head[LEADING_CODE_PRIVATE_22] = 4; + emacs_mule_charset[i] = NULL; + + charset_jisx0201_roman = -1; + charset_jisx0208_1978 = -1; + charset_jisx0208 = -1; for (i = 0; i < 128; i++) - width_by_char_head[i] = 1; + unibyte_to_multibyte_table[i] = i; for (; i < 256; i++) - width_by_char_head[i] = 4; - width_by_char_head[LEADING_CODE_PRIVATE_11] = 1; - width_by_char_head[LEADING_CODE_PRIVATE_12] = 2; - width_by_char_head[LEADING_CODE_PRIVATE_21] = 1; - width_by_char_head[LEADING_CODE_PRIVATE_22] = 2; - - { - Lisp_Object val; - - val = Qnil; - for (i = 0x81; i < 0x90; i++) - val = Fcons (make_number ((i - 0x70) << 7), val); - for (; i < 0x9A; i++) - val = Fcons (make_number ((i - 0x8F) << 14), val); - for (i = 0xA0; i < 0xF0; i++) - val = Fcons (make_number ((i - 0x70) << 7), val); - for (; i < 0xFF; i++) - val = Fcons (make_number ((i - 0xE0) << 14), val); - Vgeneric_character_list = Fnreverse (val); - } - - nonascii_insert_offset = 0; - Vnonascii_translation_table = Qnil; + unibyte_to_multibyte_table[i] = BYTE8_TO_CHAR (i); } #ifdef emacs @@ -1788,140 +2078,87 @@ init_charset_once () void syms_of_charset () { - Qcharset = intern ("charset"); - staticpro (&Qcharset); - - Qascii = intern ("ascii"); - staticpro (&Qascii); - - Qeight_bit_control = intern ("eight-bit-control"); - staticpro (&Qeight_bit_control); - - Qeight_bit_graphic = intern ("eight-bit-graphic"); - staticpro (&Qeight_bit_graphic); - - /* Define special charsets ascii, eight-bit-control, and - eight-bit-graphic. */ - update_charset_table (make_number (CHARSET_ASCII), - make_number (1), make_number (94), - make_number (1), - make_number (0), - make_number ('B'), - make_number (0), - build_string ("ASCII"), - Qnil, /* same as above */ - build_string ("ASCII (ISO646 IRV)")); - CHARSET_SYMBOL (CHARSET_ASCII) = Qascii; - Fput (Qascii, Qcharset, CHARSET_TABLE_ENTRY (CHARSET_ASCII)); - - update_charset_table (make_number (CHARSET_8_BIT_CONTROL), - make_number (1), make_number (96), - make_number (4), - make_number (0), - make_number (-1), - make_number (-1), - build_string ("8-bit control code (0x80..0x9F)"), - Qnil, /* same as above */ - Qnil); /* same as above */ - CHARSET_SYMBOL (CHARSET_8_BIT_CONTROL) = Qeight_bit_control; - Fput (Qeight_bit_control, Qcharset, - CHARSET_TABLE_ENTRY (CHARSET_8_BIT_CONTROL)); - - update_charset_table (make_number (CHARSET_8_BIT_GRAPHIC), - make_number (1), make_number (96), - make_number (4), - make_number (0), - make_number (-1), - make_number (-1), - build_string ("8-bit graphic char (0xA0..0xFF)"), - Qnil, /* same as above */ - Qnil); /* same as above */ - CHARSET_SYMBOL (CHARSET_8_BIT_GRAPHIC) = Qeight_bit_graphic; - Fput (Qeight_bit_graphic, Qcharset, - CHARSET_TABLE_ENTRY (CHARSET_8_BIT_GRAPHIC)); - - Qauto_fill_chars = intern ("auto-fill-chars"); - staticpro (&Qauto_fill_chars); - Fput (Qauto_fill_chars, Qchar_table_extra_slots, make_number (0)); - - defsubr (&Sdefine_charset); - defsubr (&Sgeneric_character_list); + DEFSYM (Qcharsetp, "charsetp"); + + DEFSYM (Qascii, "ascii"); + DEFSYM (Qunicode, "unicode"); + DEFSYM (Qeight_bit, "eight-bit"); + DEFSYM (Qiso_8859_1, "iso-8859-1"); + + DEFSYM (Qgl, "gl"); + DEFSYM (Qgr, "gr"); + + staticpro (&Vcharset_ordered_list); + Vcharset_ordered_list = Qnil; + + staticpro (&Viso_2022_charset_list); + Viso_2022_charset_list = Qnil; + + staticpro (&Vemacs_mule_charset_list); + Vemacs_mule_charset_list = Qnil; + + staticpro (&Vcharset_hash_table); + { + Lisp_Object args[2]; + args[0] = QCtest; + args[1] = Qeq; + Vcharset_hash_table = Fmake_hash_table (2, args); + } + + charset_table_size = 128; + charset_table = ((struct charset *) + xmalloc (sizeof (struct charset) * charset_table_size)); + charset_table_used = 0; + + staticpro (&Vchar_unified_charset_table); + Vchar_unified_charset_table = Fmake_char_table (Qnil, make_number (-1)); + + defsubr (&Scharsetp); + defsubr (&Smap_charset_chars); + defsubr (&Sdefine_charset_internal); + defsubr (&Sdefine_charset_alias); + defsubr (&Sunibyte_charset); + defsubr (&Sset_unibyte_charset); + defsubr (&Scharset_plist); + defsubr (&Sset_charset_plist); + defsubr (&Sunify_charset); defsubr (&Sget_unused_iso_final_char); defsubr (&Sdeclare_equiv_charset); defsubr (&Sfind_charset_region); defsubr (&Sfind_charset_string); - defsubr (&Smake_char_internal); + defsubr (&Sdecode_char); + defsubr (&Sencode_char); defsubr (&Ssplit_char); + defsubr (&Smake_char); defsubr (&Schar_charset); defsubr (&Scharset_after); defsubr (&Siso_charset); - defsubr (&Schar_valid_p); - defsubr (&Sunibyte_char_to_multibyte); - defsubr (&Smultibyte_char_to_unibyte); - defsubr (&Schar_bytes); - defsubr (&Schar_width); - defsubr (&Sstring_width); - defsubr (&Schar_direction); - defsubr (&Sstring); - defsubr (&Ssetup_special_charsets); + defsubr (&Sclear_charset_maps); + defsubr (&Scharset_priority_list); + defsubr (&Sset_charset_priority); + defsubr (&Scharset_id_internal); + + DEFVAR_LISP ("charset-map-path", &Vcharset_map_path, + doc: /* *Lisp of directories to search for charset map files. */); + Vcharset_map_path = Qnil; DEFVAR_LISP ("charset-list", &Vcharset_list, - doc: /* List of charsets ever defined. */); - Vcharset_list = Fcons (Qascii, Fcons (Qeight_bit_control, - Fcons (Qeight_bit_graphic, Qnil))); - - DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector, - doc: /* Vector of cons cell of a symbol and translation table ever defined. -An ID of a translation table is an index of this vector. */); - Vtranslation_table_vector = Fmake_vector (make_number (16), Qnil); - - DEFVAR_INT ("leading-code-private-11", &leading_code_private_11, - doc: /* Leading-code of private TYPE9N charset of column-width 1. */); - leading_code_private_11 = LEADING_CODE_PRIVATE_11; - - DEFVAR_INT ("leading-code-private-12", &leading_code_private_12, - doc: /* Leading-code of private TYPE9N charset of column-width 2. */); - leading_code_private_12 = LEADING_CODE_PRIVATE_12; - - DEFVAR_INT ("leading-code-private-21", &leading_code_private_21, - doc: /* Leading-code of private TYPE9Nx9N charset of column-width 1. */); - leading_code_private_21 = LEADING_CODE_PRIVATE_21; - - DEFVAR_INT ("leading-code-private-22", &leading_code_private_22, - doc: /* Leading-code of private TYPE9Nx9N charset of column-width 2. */); - leading_code_private_22 = LEADING_CODE_PRIVATE_22; - - DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset, - doc: /* Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte. -This is used for converting unibyte text to multibyte, -and for inserting character codes specified by number. - -This serves to convert a Latin-1 or similar 8-bit character code -to the corresponding Emacs multibyte character code. -Typically the value should be (- (make-char CHARSET 0) 128), -for your choice of character set. -If `nonascii-translation-table' is non-nil, it overrides this variable. */); - nonascii_insert_offset = 0; - - DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table, - doc: /* Translation table to convert non-ASCII unibyte codes to multibyte. -This is used for converting unibyte text to multibyte, -and for inserting character codes specified by number. - -Conversion is performed only when multibyte characters are enabled, -and it serves to convert a Latin-1 or similar 8-bit character code -to the corresponding Emacs character code. - -If this is nil, `nonascii-insert-offset' is used instead. -See also the docstring of `make-translation-table'. */); - Vnonascii_translation_table = Qnil; - - DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars, - doc: /* A char-table for characters which invoke auto-filling. -Such characters have value t in this table. */); - Vauto_fill_chars = Fmake_char_table (Qauto_fill_chars, Qnil); - CHAR_TABLE_SET (Vauto_fill_chars, make_number (' '), Qt); - CHAR_TABLE_SET (Vauto_fill_chars, make_number ('\n'), Qt); + doc: /* List of all charsets ever defined. */); + Vcharset_list = Qnil; + + charset_ascii + = define_charset_internal (Qascii, 1, "\x00\x7F\x00\x00\x00\x00", + 0, 127, 'B', -1, 0, 1, 0, 0); + charset_iso_8859_1 + = define_charset_internal (Qiso_8859_1, 1, "\x00\xFF\x00\x00\x00\x00", + 0, 255, -1, -1, -1, 1, 0, 0); + charset_unicode + = define_charset_internal (Qunicode, 3, "\x00\xFF\x00\xFF\x00\x10", + 0, MAX_UNICODE_CHAR, -1, 0, -1, 1, 0, 0); + charset_eight_bit + = define_charset_internal (Qeight_bit, 1, "\x80\xFF\x00\x00\x00\x00", + 128, 255, -1, 0, -1, 0, 0, + MAX_5_BYTE_CHAR + 1); } #endif /* emacs */ diff --git a/src/charset.h b/src/charset.h index c20766f910b..6d34a5feea3 100644 --- a/src/charset.h +++ b/src/charset.h @@ -1,4 +1,4 @@ -/* Header for multibyte character handler. +/* Header for charset handler. Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -6,6 +6,10 @@ National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify @@ -26,866 +30,523 @@ Boston, MA 02110-1301, USA. */ #ifndef EMACS_CHARSET_H #define EMACS_CHARSET_H -/* #define BYTE_COMBINING_DEBUG */ - -/*** GENERAL NOTE on CHARACTER SET (CHARSET) *** - - A character set ("charset" hereafter) is a meaningful collection - (i.e. language, culture, functionality, etc) of characters. Emacs - handles multiple charsets at once. Each charset corresponds to one - of the ISO charsets. Emacs identifies a charset by a unique - identification number, whereas ISO identifies a charset by a triplet - of DIMENSION, CHARS and FINAL-CHAR. So, hereafter, just saying - "charset" means an identification number (integer value). - - The value range of charsets is 0x00, 0x81..0xFE. There are four - kinds of charset depending on DIMENSION (1 or 2) and CHARS (94 or - 96). For instance, a charset of DIMENSION2_CHARS94 contains 94x94 - characters. - - Within Emacs Lisp, a charset is treated as a symbol which has a - property `charset'. The property value is a vector containing - various information about the charset. For readability of C code, - we use the following convention for C variable names: - charset_symbol: Emacs Lisp symbol of a charset - charset_id: Emacs Lisp integer of an identification number of a charset - charset: C integer of an identification number of a charset - - Each charset (except for ascii) is assigned a base leading-code - (range 0x80..0x9E). In addition, a charset of greater than 0xA0 - (whose base leading-code is 0x9A..0x9D) is assigned an extended - leading-code (range 0xA0..0xFE). In this case, each base - leading-code specifies the allowable range of extended leading-code - as shown in the table below. A leading-code is used to represent a - character in Emacs' buffer and string. - - We call a charset which has extended leading-code a "private - charset" because those are mainly for a charset which is not yet - registered by ISO. On the contrary, we call a charset which does - not have extended leading-code an "official charset". - - --------------------------------------------------------------------------- - charset dimension base leading-code extended leading-code - --------------------------------------------------------------------------- - 0x00 official dim1 -- none -- -- none -- - (ASCII) - 0x01..0x7F --never used-- - 0x80 official dim1 -- none -- -- none -- - (eight-bit-graphic) - 0x81..0x8F official dim1 same as charset -- none -- - 0x90..0x99 official dim2 same as charset -- none -- - 0x9A..0x9D --never used-- - 0x9E official dim1 same as charset -- none -- - (eight-bit-control) - 0x9F --never used-- - 0xA0..0xDF private dim1 0x9A same as charset - of 1-column width - 0xE0..0xEF private dim1 0x9B same as charset - of 2-column width - 0xF0..0xF4 private dim2 0x9C same as charset - of 1-column width - 0xF5..0xFE private dim2 0x9D same as charset - of 2-column width - 0xFF --never used-- - --------------------------------------------------------------------------- - -*/ - -/* Definition of special leading-codes. */ -/* Leading-code followed by extended leading-code. */ -#define LEADING_CODE_PRIVATE_11 0x9A /* for private DIMENSION1 of 1-column */ -#define LEADING_CODE_PRIVATE_12 0x9B /* for private DIMENSION1 of 2-column */ -#define LEADING_CODE_PRIVATE_21 0x9C /* for private DIMENSION2 of 1-column */ -#define LEADING_CODE_PRIVATE_22 0x9D /* for private DIMENSION2 of 2-column */ - -#define LEADING_CODE_8_BIT_CONTROL 0x9E /* for `eight-bit-control' */ - -/* Extended leading-code. */ -/* Start of each extended leading-codes. */ -#define LEADING_CODE_EXT_11 0xA0 /* follows LEADING_CODE_PRIVATE_11 */ -#define LEADING_CODE_EXT_12 0xE0 /* follows LEADING_CODE_PRIVATE_12 */ -#define LEADING_CODE_EXT_21 0xF0 /* follows LEADING_CODE_PRIVATE_21 */ -#define LEADING_CODE_EXT_22 0xF5 /* follows LEADING_CODE_PRIVATE_22 */ -/* Maximum value of extended leading-codes. */ -#define LEADING_CODE_EXT_MAX 0xFE - -/* Definition of minimum/maximum charset of each DIMENSION. */ -#define MIN_CHARSET_OFFICIAL_DIMENSION1 0x80 -#define MAX_CHARSET_OFFICIAL_DIMENSION1 0x8F -#define MIN_CHARSET_OFFICIAL_DIMENSION2 0x90 -#define MAX_CHARSET_OFFICIAL_DIMENSION2 0x99 -#define MIN_CHARSET_PRIVATE_DIMENSION1 LEADING_CODE_EXT_11 -#define MIN_CHARSET_PRIVATE_DIMENSION2 LEADING_CODE_EXT_21 - -/* Maximum value of overall charset identification number. */ -#define MAX_CHARSET 0xFE - -/* Definition of special charsets. */ -#define CHARSET_ASCII 0 /* 0x00..0x7F */ -#define CHARSET_8_BIT_CONTROL 0x9E /* 0x80..0x9F */ -#define CHARSET_8_BIT_GRAPHIC 0x80 /* 0xA0..0xFF */ - -extern int charset_latin_iso8859_1; /* ISO8859-1 (Latin-1) */ -extern int charset_jisx0208_1978; /* JISX0208.1978 (Japanese Kanji old set) */ -extern int charset_jisx0208; /* JISX0208.1983 (Japanese Kanji) */ -extern int charset_katakana_jisx0201; /* JISX0201.Kana (Japanese Katakana) */ -extern int charset_latin_jisx0201; /* JISX0201.Roman (Japanese Roman) */ -extern int charset_big5_1; /* Big5 Level 1 (Chinese Traditional) */ -extern int charset_big5_2; /* Big5 Level 2 (Chinese Traditional) */ -extern int charset_mule_unicode_0100_24ff; -extern int charset_mule_unicode_2500_33ff; -extern int charset_mule_unicode_e000_ffff; - -/* Check if CH is an ASCII character or a base leading-code. - Nowadays, any byte can be the first byte of a character in a - multibyte buffer/string. So this macro name is not appropriate. */ -#define CHAR_HEAD_P(ch) ((unsigned char) (ch) < 0xA0) - -/*** GENERAL NOTE on CHARACTER REPRESENTATION *** - - Firstly, the term "character" or "char" is used for a multilingual - character (of course, including ASCII characters), not for a byte in - computer memory. We use the term "code" or "byte" for the latter - case. - - A character is identified by charset and one or two POSITION-CODEs. - POSITION-CODE is the position of the character in the charset. A - character of DIMENSION1 charset has one POSITION-CODE: POSITION-CODE-1. - A character of DIMENSION2 charset has two POSITION-CODE: - POSITION-CODE-1 and POSITION-CODE-2. The code range of - POSITION-CODE is 0x20..0x7F. - - Emacs has two kinds of representation of a character: multi-byte - form (for buffers and strings) and single-word form (for character - objects in Emacs Lisp). The latter is called "character code" - hereafter. Both representations encode the information of charset - and POSITION-CODE but in a different way (for instance, the MSB of - POSITION-CODE is set in multi-byte form). - - For details of the multi-byte form, see the section "2. Emacs - internal format handlers" of `coding.c'. - - Emacs uses 19 bits for a character code. The bits are divided into - 3 fields: FIELD1(5bits):FIELD2(7bits):FIELD3(7bits). - - A character code of DIMENSION1 character uses FIELD2 to hold charset - and FIELD3 to hold POSITION-CODE-1. A character code of DIMENSION2 - character uses FIELD1 to hold charset, FIELD2 and FIELD3 to hold - POSITION-CODE-1 and POSITION-CODE-2 respectively. - - More precisely... - - FIELD2 of DIMENSION1 character (except for ascii, eight-bit-control, - and eight-bit-graphic) is "charset - 0x70". This is to make all - character codes except for ASCII and 8-bit codes greater than 256. - So, the range of FIELD2 of DIMENSION1 character is 0, 1, or - 0x11..0x7F. - - FIELD1 of DIMENSION2 character is "charset - 0x8F" for official - charset and "charset - 0xE0" for private charset. So, the range of - FIELD1 of DIMENSION2 character is 0x01..0x1E. - - ----------------------------------------------------------------------------- - charset FIELD1 (5-bit) FIELD2 (7-bit) FIELD3 (7-bit) - ----------------------------------------------------------------------------- - ascii 0 0 0x00..0x7F - eight-bit-control 0 1 0x00..0x1F - eight-bit-graphic 0 1 0x20..0x7F - DIMENSION1 0 charset - 0x70 POSITION-CODE-1 - DIMENSION2(o) charset - 0x8F POSITION-CODE-1 POSITION-CODE-2 - DIMENSION2(p) charset - 0xE0 POSITION-CODE-1 POSITION-CODE-2 - ----------------------------------------------------------------------------- - "(o)": official, "(p)": private - ----------------------------------------------------------------------------- -*/ - -/* Masks of each field of character code. */ -#define CHAR_FIELD1_MASK (0x1F << 14) -#define CHAR_FIELD2_MASK (0x7F << 7) -#define CHAR_FIELD3_MASK 0x7F - -/* Macros to access each field of character C. */ -#define CHAR_FIELD1(c) (((c) & CHAR_FIELD1_MASK) >> 14) -#define CHAR_FIELD2(c) (((c) & CHAR_FIELD2_MASK) >> 7) -#define CHAR_FIELD3(c) ((c) & CHAR_FIELD3_MASK) - -/* Minimum character code of character of each DIMENSION. */ -#define MIN_CHAR_OFFICIAL_DIMENSION1 \ - ((0x81 - 0x70) << 7) -#define MIN_CHAR_PRIVATE_DIMENSION1 \ - ((MIN_CHARSET_PRIVATE_DIMENSION1 - 0x70) << 7) -#define MIN_CHAR_OFFICIAL_DIMENSION2 \ - ((MIN_CHARSET_OFFICIAL_DIMENSION2 - 0x8F) << 14) -#define MIN_CHAR_PRIVATE_DIMENSION2 \ - ((MIN_CHARSET_PRIVATE_DIMENSION2 - 0xE0) << 14) -/* Maximum character code currently used plus 1. */ -#define MAX_CHAR (0x1F << 14) - -/* 1 if C is a single byte character, else 0. */ -#define SINGLE_BYTE_CHAR_P(c) (((unsigned)(c) & 0xFF) == (c)) - -/* 1 if BYTE is an ASCII character in itself, in multibyte mode. */ -#define ASCII_BYTE_P(byte) ((byte) < 0x80) - -/* A char-table containing information on each character set. - - Unlike ordinary char-tables, this doesn't contain any nested tables. - Only the top level elements are used. Each element is a vector of - the following information: - CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION, - LEADING-CODE-BASE, LEADING-CODE-EXT, - ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE, - REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION, - PLIST. - - CHARSET-ID (integer) is the identification number of the charset. - - BYTES (integer) is the length of the multi-byte form of a character - in the charset: one of 1, 2, 3, and 4. - - DIMENSION (integer) is the number of bytes to represent a character: 1 or 2. - - CHARS (integer) is the number of characters in a dimension: 94 or 96. - - WIDTH (integer) is the number of columns a character in the charset - occupies on the screen: one of 0, 1, and 2.. - - DIRECTION (integer) is the rendering direction of characters in the - charset when rendering. If 0, render from left to right, else - render from right to left. - - LEADING-CODE-BASE (integer) is the base leading-code for the - charset. - - LEADING-CODE-EXT (integer) is the extended leading-code for the - charset. All charsets of less than 0xA0 have the value 0. - - ISO-FINAL-CHAR (character) is the final character of the - corresponding ISO 2022 charset. It is -1 for such a character - that is used only internally (e.g. `eight-bit-control'). - - ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked - while encoding to variants of ISO 2022 coding system, one of the - following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR). It - is -1 for such a character that is used only internally - (e.g. `eight-bit-control'). - - REVERSE-CHARSET (integer) is the charset which differs only in - LEFT-TO-RIGHT value from the charset. If there's no such a - charset, the value is -1. - - SHORT-NAME (string) is the short name to refer to the charset. - - LONG-NAME (string) is the long name to refer to the charset. - - DESCRIPTION (string) is the description string of the charset. - - PLIST (property list) may contain any type of information a user - wants to put and get by functions `put-charset-property' and - `get-charset-property' respectively. */ -extern Lisp_Object Vcharset_table; - -/* Macros to access various information of CHARSET in Vcharset_table. - We provide these macros for efficiency. No range check of CHARSET. */ - -/* Return entry of CHARSET (C integer) in Vcharset_table. */ -#define CHARSET_TABLE_ENTRY(charset) \ - XCHAR_TABLE (Vcharset_table)->contents[((charset) == CHARSET_ASCII \ - ? 0 : (charset) + 128)] - -/* Return information INFO-IDX of CHARSET. */ -#define CHARSET_TABLE_INFO(charset, info_idx) \ - XVECTOR (CHARSET_TABLE_ENTRY (charset))->contents[info_idx] - -#define CHARSET_ID_IDX (0) -#define CHARSET_BYTES_IDX (1) -#define CHARSET_DIMENSION_IDX (2) -#define CHARSET_CHARS_IDX (3) -#define CHARSET_WIDTH_IDX (4) -#define CHARSET_DIRECTION_IDX (5) -#define CHARSET_LEADING_CODE_BASE_IDX (6) -#define CHARSET_LEADING_CODE_EXT_IDX (7) -#define CHARSET_ISO_FINAL_CHAR_IDX (8) -#define CHARSET_ISO_GRAPHIC_PLANE_IDX (9) -#define CHARSET_REVERSE_CHARSET_IDX (10) -#define CHARSET_SHORT_NAME_IDX (11) -#define CHARSET_LONG_NAME_IDX (12) -#define CHARSET_DESCRIPTION_IDX (13) -#define CHARSET_PLIST_IDX (14) -/* Size of a vector of each entry of Vcharset_table. */ -#define CHARSET_MAX_IDX (15) - -/* And several more macros to be used frequently. */ -#define CHARSET_BYTES(charset) \ - XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX)) -#define CHARSET_DIMENSION(charset) \ - XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX)) -#define CHARSET_CHARS(charset) \ - XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX)) -#define CHARSET_WIDTH(charset) \ - XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX)) -#define CHARSET_DIRECTION(charset) \ - XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX)) -#define CHARSET_LEADING_CODE_BASE(charset) \ - XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX)) -#define CHARSET_LEADING_CODE_EXT(charset) \ - XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX)) -#define CHARSET_ISO_FINAL_CHAR(charset) \ - XINT (CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX)) -#define CHARSET_ISO_GRAPHIC_PLANE(charset) \ - XINT (CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX)) -#define CHARSET_REVERSE_CHARSET(charset) \ - XINT (CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)) - -/* Macros to specify direction of a charset. */ -#define CHARSET_DIRECTION_LEFT_TO_RIGHT 0 -#define CHARSET_DIRECTION_RIGHT_TO_LEFT 1 - -/* A vector of charset symbol indexed by charset-id. This is used - only for returning charset symbol from C functions. */ -extern Lisp_Object Vcharset_symbol_table; - -/* Return symbol of CHARSET. */ -#define CHARSET_SYMBOL(charset) \ - XVECTOR (Vcharset_symbol_table)->contents[charset] - -/* 1 if CHARSET is in valid value range, else 0. */ -#define CHARSET_VALID_P(charset) \ - ((charset) == 0 \ - || ((charset) > 0x80 && (charset) <= MAX_CHARSET_OFFICIAL_DIMENSION2) \ - || ((charset) >= MIN_CHARSET_PRIVATE_DIMENSION1 \ - && (charset) <= MAX_CHARSET) \ - || ((charset) == CHARSET_8_BIT_CONTROL) \ - || ((charset) == CHARSET_8_BIT_GRAPHIC)) - -/* 1 if CHARSET is already defined, else 0. */ -#define CHARSET_DEFINED_P(charset) \ - (((charset) >= 0) && ((charset) <= MAX_CHARSET) \ - && !NILP (CHARSET_TABLE_ENTRY (charset))) - -/* Since the information CHARSET-BYTES and CHARSET-WIDTH of - Vcharset_table can be retrieved only by the first byte of - multi-byte form (an ASCII code or a base leading-code), we provide - here tables to be used by macros BYTES_BY_CHAR_HEAD and - WIDTH_BY_CHAR_HEAD for faster information retrieval. */ -extern int bytes_by_char_head[256]; -extern int width_by_char_head[256]; - -#define BYTES_BY_CHAR_HEAD(char_head) \ - (ASCII_BYTE_P (char_head) ? 1 : bytes_by_char_head[char_head]) -#define WIDTH_BY_CHAR_HEAD(char_head) \ - (ASCII_BYTE_P (char_head) ? 1 : width_by_char_head[char_head]) - -/* Charset of the character C. */ -#define CHAR_CHARSET(c) \ - (SINGLE_BYTE_CHAR_P (c) \ - ? (ASCII_BYTE_P (c) \ - ? CHARSET_ASCII \ - : (c) < 0xA0 ? CHARSET_8_BIT_CONTROL : CHARSET_8_BIT_GRAPHIC) \ - : ((c) < MIN_CHAR_OFFICIAL_DIMENSION2 \ - ? CHAR_FIELD2 (c) + 0x70 \ - : ((c) < MIN_CHAR_PRIVATE_DIMENSION2 \ - ? CHAR_FIELD1 (c) + 0x8F \ - : CHAR_FIELD1 (c) + 0xE0))) +/* Index to arguments of Fdefine_charset_internal. */ + +enum define_charset_arg_index + { + charset_arg_name, + charset_arg_dimension, + charset_arg_code_space, + charset_arg_min_code, + charset_arg_max_code, + charset_arg_iso_final, + charset_arg_iso_revision, + charset_arg_emacs_mule_id, + charset_arg_ascii_compatible_p, + charset_arg_supplementary_p, + charset_arg_invalid_code, + charset_arg_code_offset, + charset_arg_map, + charset_arg_subset, + charset_arg_superset, + charset_arg_unify_map, + charset_arg_plist, + charset_arg_max + }; + + +/* Indices to charset attributes vector. */ + +enum charset_attr_index + { + /* ID number of the charset. */ + charset_id, + + /* Name of the charset (symbol). */ + charset_name, + + /* Property list of the charset. */ + charset_plist, + + /* If the method of the charset is `MAP_DEFERRED', the value is a + mapping vector or a file name that contains mapping vector. + Otherwise, nil. */ + charset_map, + + /* If the method of the charset is `MAP', the value is a vector + that maps code points of the charset to characters. The vector + is indexed by a character index. A character index is + calculated from a code point and the code-space table of the + charset. */ + charset_decoder, + + /* If the method of the charset is `MAP', the value is a + char-table that maps characters of the charset to code + points. */ + charset_encoder, + + /* If the method of the charset is `SUBSET', the value is a vector + that has this form: + + [ CHARSET-ID MIN-CODE MAX-CODE OFFSET ] + + CHARSET-ID is an ID number of a parent charset. MIN-CODE and + MAX-CODE specify the range of characters inherited from the + parent. OFFSET is an integer value to add to a code point of + the parent charset to get the corresponding code point of this + charset. */ + charset_subset, + + /* If the method of the charset is `SUPERSET', the value is a list + whose elements have this form: + + (CHARSET-ID . OFFSET) + + CHARSET-IDs are ID numbers of parent charsets. OFFSET is an + integer value to add to a code point of the parent charset to + get the corresponding code point of this charset. */ + charset_superset, + + /* The value is a mapping vector or a file name that contains the + mapping. This defines how characters in the charset should be + unified with Unicode. The value of the member + `charset_deunifier' is created from this information. */ + charset_unify_map, + + /* If characters in the charset must be unified Unicode, the value + is a char table that maps a unified Unicode character code to + the non-unified character code in the charset. */ + charset_deunifier, + + /* The length of the charset attribute vector. */ + charset_attr_max + }; + +/* Methods for converting code points and characters of charsets. */ + +enum charset_method + { + /* For a charset of this method, a character code is calculated + from a character index (which is calculated from a code point) + simply by adding an offset value. */ + CHARSET_METHOD_OFFSET, + + /* For a charset of this method, a decoder vector and an encoder + char-table is used for code point <-> character code + conversion. */ + CHARSET_METHOD_MAP, + + /* Same as above but decoder and encoder are loaded from a file on + demand. Once loaded, the method is changed to + CHARSET_METHOD_MAP. */ + CHARSET_METHOD_MAP_DEFERRED, + + /* A charset of this method is a subset of another charset. */ + CHARSET_METHOD_SUBSET, + + /* A charset of this method is a superset of other charsets. */ + CHARSET_METHOD_SUPERSET + }; + +struct charset +{ + /* Index to charset_table. */ + int id; -/* Check if two characters C1 and C2 belong to the same charset. */ -#define SAME_CHARSET_P(c1, c2) \ - (c1 < MIN_CHAR_OFFICIAL_DIMENSION2 \ - ? (c1 & CHAR_FIELD2_MASK) == (c2 & CHAR_FIELD2_MASK) \ - : (c1 & CHAR_FIELD1_MASK) == (c2 & CHAR_FIELD1_MASK)) - -/* Return a character of which charset is CHARSET and position-codes - are C1 and C2. DIMENSION1 character ignores C2. */ -#define MAKE_CHAR(charset, c1, c2) \ - ((charset) == CHARSET_ASCII \ - ? (c1) & 0x7F \ - : (((charset) == CHARSET_8_BIT_CONTROL \ - || (charset) == CHARSET_8_BIT_GRAPHIC) \ - ? ((c1) & 0x7F) | 0x80 \ - : ((CHARSET_DEFINED_P (charset) \ - ? CHARSET_DIMENSION (charset) == 1 \ - : (charset) < MIN_CHARSET_PRIVATE_DIMENSION2) \ - ? (((charset) - 0x70) << 7) | ((c1) <= 0 ? 0 : ((c1) & 0x7F)) \ - : ((((charset) \ - - ((charset) < MIN_CHARSET_PRIVATE_DIMENSION2 ? 0x8F : 0xE0)) \ - << 14) \ - | ((c2) <= 0 ? 0 : ((c2) & 0x7F)) \ - | ((c1) <= 0 ? 0 : (((c1) & 0x7F) << 7)))))) - - -/* If GENERICP is nonzero, return nonzero if C is a valid normal or - generic character. If GENERICP is zero, return nonzero if C is a - valid normal character. */ -#define CHAR_VALID_P(c, genericp) \ - ((c) >= 0 \ - && (SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, genericp))) - -/* This default value is used when nonascii-translation-table or - nonascii-insert-offset fail to convert unibyte character to a valid - multibyte character. This makes a Latin-1 character. */ - -#define DEFAULT_NONASCII_INSERT_OFFSET 0x800 - -/* Parse multibyte string STR of length LENGTH and set BYTES to the - byte length of a character at STR. */ - -#ifdef BYTE_COMBINING_DEBUG - -#define PARSE_MULTIBYTE_SEQ(str, length, bytes) \ + /* Index to Vcharset_hash_table. */ + int hash_index; + + /* Dimension of the charset: 1, 2, 3, or 4. */ + int dimension; + + /* Byte code range of each dimension. <code_space>[4N] is a mininum + byte code of the (N+1)th dimension, <code_space>[4N+1] is a + maximum byte code of the (N+1)th dimension, <code_space>[4N+2] is + (<code_space>[4N+1] - <code_space>[4N] + 1), <code_space>[4N+3] + is a number of characters containd in the first to (N+1)th + dismesions. We get `char-index' of a `code-point' from this + information. */ + int code_space[16]; + + /* If B is a byte of Nth dimension of a code-point, the (N-1)th bit + of code_space_mask[B] is set. This array is used to quickly + check if a code-point is in a valid range. */ + unsigned char *code_space_mask; + + /* 1 if there's no gap in code-points. */ + int code_linear_p; + + /* If the charset is treated as 94-chars in ISO-2022, the value is 0. + If the charset is treated as 96-chars in ISO-2022, the value is 1. */ + int iso_chars_96; + + /* ISO final byte of the charset: 48..127. It may be -1 if the + charset doesn't conform to ISO-2022. */ + int iso_final; + + /* ISO revision number of the charset. */ + int iso_revision; + + /* If the charset is identical to what supported by Emacs 21 and the + priors, the identification number of the charset used in those + version. Otherwise, -1. */ + int emacs_mule_id; + + /* Nonzero if the charset is compatible with ASCII. */ + int ascii_compatible_p; + + /* Nonzero if the charset is supplementary. */ + int supplementary_p; + + /* Nonzero if all the code points are representable by Lisp_Int. */ + int compact_codes_p; + + /* The method for encoding/decoding characters of the charset. */ + enum charset_method method; + + /* Mininum and Maximum code points of the charset. */ + unsigned min_code, max_code; + + /* Offset value used by macros CODE_POINT_TO_INDEX and + INDEX_TO_CODE_POINT. . */ + unsigned char_index_offset; + + /* Mininum and Maximum character codes of the charset. If the + charset is compatible with ASCII, min_char is a minimum non-ASCII + character of the charset. If the method of charset is + CHARSET_METHOD_OFFSET, even if the charset is unified, min_char + and max_char doesn't change. */ + int min_char, max_char; + + /* The code returned by ENCODE_CHAR if a character is not encodable + by the charset. */ + unsigned invalid_code; + + /* If the method of the charset is CHARSET_METHOD_MAP, this is a + table of bits used to quickly and roughly guess if a character + belongs to the charset. + + The first 64 elements are 512 bits for characters less than + 0x10000. Each bit corresponds to 128-character block. The last + 126 elements are 1008 bits for the greater characters + (0x10000..0x3FFFFF). Each bit corresponds to 4096-character + block. + + If a bit is 1, at least one character in the corresponding block is + in this charset. */ + unsigned char fast_map[190]; + + /* Offset value to calculate a character code from code-point, and + visa versa. */ + int code_offset; + + int unified_p; +}; + +/* Hash table of charset symbols vs. the correponding attribute + vectors. */ +extern Lisp_Object Vcharset_hash_table; + +/* Table of struct charset. */ +extern struct charset *charset_table; + +#define CHARSET_FROM_ID(id) (charset_table + (id)) + +extern Lisp_Object Vcharset_ordered_list; + +/* Incremented everytime we change the priority of charsets. */ +extern unsigned short charset_ordered_list_tick; + +extern Lisp_Object Vcharset_list; +extern Lisp_Object Viso_2022_charset_list; +extern Lisp_Object Vemacs_mule_charset_list; + +extern struct charset *emacs_mule_charset[256]; + + +/* Macros to access information about charset. */ + +/* Return the attribute vector of charset whose symbol is SYMBOL. */ +#define CHARSET_SYMBOL_ATTRIBUTES(symbol) \ + Fgethash ((symbol), Vcharset_hash_table, Qnil) + +#define CHARSET_ATTR_ID(attrs) AREF ((attrs), charset_id) +#define CHARSET_ATTR_NAME(attrs) AREF ((attrs), charset_name) +#define CHARSET_ATTR_PLIST(attrs) AREF ((attrs), charset_plist) +#define CHARSET_ATTR_MAP(attrs) AREF ((attrs), charset_map) +#define CHARSET_ATTR_DECODER(attrs) AREF ((attrs), charset_decoder) +#define CHARSET_ATTR_ENCODER(attrs) AREF ((attrs), charset_encoder) +#define CHARSET_ATTR_SUBSET(attrs) AREF ((attrs), charset_subset) +#define CHARSET_ATTR_SUPERSET(attrs) AREF ((attrs), charset_superset) +#define CHARSET_ATTR_UNIFY_MAP(attrs) AREF ((attrs), charset_unify_map) +#define CHARSET_ATTR_DEUNIFIER(attrs) AREF ((attrs), charset_deunifier) + +#define CHARSET_SYMBOL_ID(symbol) \ + CHARSET_ATTR_ID (CHARSET_SYMBOL_ATTRIBUTES (symbol)) + +/* Return an index to Vcharset_hash_table of the charset whose symbol + is SYMBOL. */ +#define CHARSET_SYMBOL_HASH_INDEX(symbol) \ + hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol, NULL) + +/* Return the attribute vector of CHARSET. */ +#define CHARSET_ATTRIBUTES(charset) \ + (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), (charset)->hash_index)) + +#define CHARSET_ID(charset) ((charset)->id) +#define CHARSET_HASH_INDEX(charset) ((charset)->hash_index) +#define CHARSET_DIMENSION(charset) ((charset)->dimension) +#define CHARSET_CODE_SPACE(charset) ((charset)->code_space) +#define CHARSET_CODE_LINEAR_P(charset) ((charset)->code_linear_p) +#define CHARSET_ISO_CHARS_96(charset) ((charset)->iso_chars_96) +#define CHARSET_ISO_FINAL(charset) ((charset)->iso_final) +#define CHARSET_ISO_PLANE(charset) ((charset)->iso_plane) +#define CHARSET_ISO_REVISION(charset) ((charset)->iso_revision) +#define CHARSET_EMACS_MULE_ID(charset) ((charset)->emacs_mule_id) +#define CHARSET_ASCII_COMPATIBLE_P(charset) ((charset)->ascii_compatible_p) +#define CHARSET_COMPACT_CODES_P(charset) ((charset)->compact_codes_p) +#define CHARSET_METHOD(charset) ((charset)->method) +#define CHARSET_MIN_CODE(charset) ((charset)->min_code) +#define CHARSET_MAX_CODE(charset) ((charset)->max_code) +#define CHARSET_INVALID_CODE(charset) ((charset)->invalid_code) +#define CHARSET_MIN_CHAR(charset) ((charset)->min_char) +#define CHARSET_MAX_CHAR(charset) ((charset)->max_char) +#define CHARSET_CODE_OFFSET(charset) ((charset)->code_offset) +#define CHARSET_UNIFIED_P(charset) ((charset)->unified_p) + +#define CHARSET_NAME(charset) \ + (CHARSET_ATTR_NAME (CHARSET_ATTRIBUTES (charset))) +#define CHARSET_MAP(charset) \ + (CHARSET_ATTR_MAP (CHARSET_ATTRIBUTES (charset))) +#define CHARSET_DECODER(charset) \ + (CHARSET_ATTR_DECODER (CHARSET_ATTRIBUTES (charset))) +#define CHARSET_ENCODER(charset) \ + (CHARSET_ATTR_ENCODER (CHARSET_ATTRIBUTES (charset))) +#define CHARSET_SUBSET(charset) \ + (CHARSET_ATTR_SUBSET (CHARSET_ATTRIBUTES (charset))) +#define CHARSET_SUPERSET(charset) \ + (CHARSET_ATTR_SUPERSET (CHARSET_ATTRIBUTES (charset))) +#define CHARSET_UNIFY_MAP(charset) \ + (CHARSET_ATTR_UNIFY_MAP (CHARSET_ATTRIBUTES (charset))) +#define CHARSET_DEUNIFIER(charset) \ + (CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset))) + + +/* Nonzero if OBJ is a valid charset symbol. */ +#define CHARSETP(obj) (CHARSET_SYMBOL_HASH_INDEX (obj) >= 0) + +/* Check if X is a valid charset symbol. If not, signal an error. */ +#define CHECK_CHARSET(x) \ do { \ - int i = 1; \ - while (i < (length) && ! CHAR_HEAD_P ((str)[i])) i++; \ - (bytes) = BYTES_BY_CHAR_HEAD ((str)[0]); \ - if ((bytes) > i) \ - abort (); \ + if (! SYMBOLP (x) || CHARSET_SYMBOL_HASH_INDEX (x) < 0) \ + x = wrong_type_argument (Qcharsetp, (x)); \ } while (0) -#else /* not BYTE_COMBINING_DEBUG */ - -#define PARSE_MULTIBYTE_SEQ(str, length, bytes) \ - ((void)(length), (bytes) = BYTES_BY_CHAR_HEAD ((str)[0])) - -#endif /* not BYTE_COMBINING_DEBUG */ - -#define VALID_LEADING_CODE_P(code) \ - (! NILP (CHARSET_TABLE_ENTRY (code))) - -/* Return 1 if the byte sequence at unibyte string STR (LENGTH bytes) - is valid as a multibyte form. If valid, by a side effect, BYTES is - set to the byte length of the multibyte form. */ - -#define UNIBYTE_STR_AS_MULTIBYTE_P(str, length, bytes) \ - (((str)[0] < 0x80 || (str)[0] >= 0xA0) \ - ? ((bytes) = 1) \ - : (((bytes) = BYTES_BY_CHAR_HEAD ((str)[0])), \ - ((bytes) <= (length) \ - && !CHAR_HEAD_P ((str)[1]) \ - && ((bytes) == 2 \ - ? (str)[0] != LEADING_CODE_8_BIT_CONTROL \ - : (!CHAR_HEAD_P ((str)[2]) \ - && ((bytes) == 3 \ - ? (((str)[0] != LEADING_CODE_PRIVATE_11 \ - && (str)[0] != LEADING_CODE_PRIVATE_12) \ - || VALID_LEADING_CODE_P (str[1])) \ - : (!CHAR_HEAD_P ((str)[3]) \ - && VALID_LEADING_CODE_P (str[1])))))))) - - -/* Return 1 if the byte sequence at multibyte string STR is valid as - a unibyte form. By a side effect, BYTES is set to the byte length - of one character at STR. */ - -#define MULTIBYTE_STR_AS_UNIBYTE_P(str, bytes) \ - ((bytes) = BYTES_BY_CHAR_HEAD ((str)[0]), \ - (str)[0] != LEADING_CODE_8_BIT_CONTROL) - -/* The charset of character C is stored in CHARSET, and the - position-codes of C are stored in C1 and C2. - We store -1 in C2 if the dimension of the charset is 1. */ - -#define SPLIT_CHAR(c, charset, c1, c2) \ - (SINGLE_BYTE_CHAR_P (c) \ - ? ((charset \ - = (ASCII_BYTE_P (c) \ - ? CHARSET_ASCII \ - : ((c) < 0xA0 ? CHARSET_8_BIT_CONTROL : CHARSET_8_BIT_GRAPHIC))), \ - c1 = (c), c2 = -1) \ - : ((c) & CHAR_FIELD1_MASK \ - ? (charset = (CHAR_FIELD1 (c) \ - + ((c) < MIN_CHAR_PRIVATE_DIMENSION2 ? 0x8F : 0xE0)), \ - c1 = CHAR_FIELD2 (c), \ - c2 = CHAR_FIELD3 (c)) \ - : (charset = CHAR_FIELD2 (c) + 0x70, \ - c1 = CHAR_FIELD3 (c), \ - c2 = -1))) - -/* Return 1 if character C has valid printable glyph. */ -#define CHAR_PRINTABLE_P(c) (ASCII_BYTE_P (c) || char_printable_p (c)) - -/* The charset of the character at STR is stored in CHARSET, and the - position-codes are stored in C1 and C2. - We store -1 in C2 if the character is just 2 bytes. */ - -#define SPLIT_STRING(str, len, charset, c1, c2) \ - ((BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) < 2 \ - || BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) > len \ - || split_string (str, len, &charset, &c1, &c2) < 0) \ - ? c1 = *(str), charset = CHARSET_ASCII \ - : charset) -/* Mapping table from ISO2022's charset (specified by DIMENSION, - CHARS, and FINAL_CHAR) to Emacs' charset. Should be accessed by - macro ISO_CHARSET_TABLE (DIMENSION, CHARS, FINAL_CHAR). */ -extern int iso_charset_table[2][2][128]; - -#define ISO_CHARSET_TABLE(dimension, chars, final_char) \ - iso_charset_table[XINT (dimension) - 1][XINT (chars) > 94][XINT (final_char)] - -#define BASE_LEADING_CODE_P(c) (BYTES_BY_CHAR_HEAD ((unsigned char) (c)) > 1) - -/* Return how many bytes C will occupy in a multibyte buffer. */ -#define CHAR_BYTES(c) \ - (SINGLE_BYTE_CHAR_P (c) \ - ? ((ASCII_BYTE_P (c) || (c) >= 0xA0) ? 1 : 2) \ - : char_bytes (c)) - -/* The following two macros CHAR_STRING and STRING_CHAR are the main - entry points to convert between Emacs's two types of character - representations: multi-byte form and single-word form (character - code). */ - -/* Store multi-byte form of the character C in STR. The caller should - allocate at least MAX_MULTIBYTE_LENGTH bytes area at STR in - advance. Returns the length of the multi-byte form. If C is an - invalid character code, signal an error. */ - -#define CHAR_STRING(c, str) \ - (SINGLE_BYTE_CHAR_P (c) \ - ? ((ASCII_BYTE_P (c) || c >= 0xA0) \ - ? (*(str) = (unsigned char)(c), 1) \ - : (*(str) = LEADING_CODE_8_BIT_CONTROL, *((str)+ 1) = c + 0x20, 2)) \ - : char_to_string (c, (unsigned char *) str)) - -/* Like CHAR_STRING but don't signal an error if C is invalid. - Value is -1 in this case. */ - -#define CHAR_STRING_NO_SIGNAL(c, str) \ - (SINGLE_BYTE_CHAR_P (c) \ - ? ((ASCII_BYTE_P (c) || c >= 0xA0) \ - ? (*(str) = (unsigned char)(c), 1) \ - : (*(str) = LEADING_CODE_8_BIT_CONTROL, *((str)+ 1) = c + 0x20, 2)) \ - : char_to_string_1 (c, (unsigned char *) str)) - -/* Return a character code of the character of which multi-byte form - is at STR and the length is LEN. If STR doesn't contain valid - multi-byte form, only the first byte in STR is returned. */ - -#define STRING_CHAR(str, len) \ - (BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) == 1 \ - ? (unsigned char) *(str) \ - : string_to_char (str, len, 0)) - -/* This is like STRING_CHAR but the third arg ACTUAL_LEN is set to the - length of the multi-byte form. Just to know the length, use - MULTIBYTE_FORM_LENGTH. */ - -#define STRING_CHAR_AND_LENGTH(str, len, actual_len) \ - (BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) == 1 \ - ? ((actual_len) = 1), (unsigned char) *(str) \ - : string_to_char (str, len, &(actual_len))) - -/* Fetch the "next" character from Lisp string STRING at byte position - BYTEIDX, character position CHARIDX. Store it into OUTPUT. - - All the args must be side-effect-free. - BYTEIDX and CHARIDX must be lvalues; - we increment them past the character fetched. */ - -#define FETCH_STRING_CHAR_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \ -if (1) \ - { \ - CHARIDX++; \ - if (STRING_MULTIBYTE (STRING)) \ - { \ - const unsigned char *ptr = SDATA (STRING) + BYTEIDX; \ - int space_left = SBYTES (STRING) - BYTEIDX; \ - int actual_len; \ - \ - OUTPUT = STRING_CHAR_AND_LENGTH (ptr, space_left, actual_len); \ - BYTEIDX += actual_len; \ - } \ - else \ - OUTPUT = SREF (STRING, BYTEIDX++); \ - } \ -else - -/* Like FETCH_STRING_CHAR_ADVANCE but assume STRING is multibyte. */ - -#define FETCH_STRING_CHAR_ADVANCE_NO_CHECK(OUTPUT, STRING, CHARIDX, BYTEIDX) \ -if (1) \ - { \ - const unsigned char *fetch_string_char_ptr = SDATA (STRING) + BYTEIDX; \ - int fetch_string_char_space_left = SBYTES (STRING) - BYTEIDX; \ - int actual_len; \ - \ - OUTPUT \ - = STRING_CHAR_AND_LENGTH (fetch_string_char_ptr, \ - fetch_string_char_space_left, actual_len); \ - \ - BYTEIDX += actual_len; \ - CHARIDX++; \ - } \ -else - -/* Like FETCH_STRING_CHAR_ADVANCE but fetch character from the current - buffer. */ - -#define FETCH_CHAR_ADVANCE(OUTPUT, CHARIDX, BYTEIDX) \ -if (1) \ - { \ - CHARIDX++; \ - if (!NILP (current_buffer->enable_multibyte_characters)) \ - { \ - unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \ - int space_left = ((CHARIDX < GPT ? GPT_BYTE : Z_BYTE) - BYTEIDX); \ - int actual_len; \ - \ - OUTPUT= STRING_CHAR_AND_LENGTH (ptr, space_left, actual_len); \ - BYTEIDX += actual_len; \ - } \ - else \ - { \ - OUTPUT = *(BYTE_POS_ADDR (BYTEIDX)); \ - BYTEIDX++; \ - } \ - } \ -else - -/* Return the length of the multi-byte form at string STR of length LEN. */ - -#define MULTIBYTE_FORM_LENGTH(str, len) \ - (BYTES_BY_CHAR_HEAD (*(unsigned char *)(str)) == 1 \ - ? 1 \ - : multibyte_form_length (str, len)) - -/* If P is before LIMIT, advance P to the next character boundary. It - assumes that P is already at a character boundary of the sane - mulitbyte form whose end address is LIMIT. */ - -#define NEXT_CHAR_BOUNDARY(p, limit) \ - do { \ - if ((p) < (limit)) \ - (p) += BYTES_BY_CHAR_HEAD (*(p)); \ +/* Check if X is a valid charset symbol. If valid, set ID to the id + number of the charset. Otherwise, signal an error. */ +#define CHECK_CHARSET_GET_ID(x, id) \ + do { \ + int idx; \ + \ + if (! SYMBOLP (x) || (idx = CHARSET_SYMBOL_HASH_INDEX (x)) < 0) \ + x = wrong_type_argument (Qcharsetp, (x)); \ + id = XINT (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \ + charset_id)); \ } while (0) -/* If P is after LIMIT, advance P to the previous character boundary. */ - -#define PREV_CHAR_BOUNDARY(p, limit) \ +/* Check if X is a valid charset symbol. If valid, set ATTR to the + attr vector of the charset. Otherwise, signal an error. */ +#define CHECK_CHARSET_GET_ATTR(x, attr) \ do { \ - if ((p) > (limit)) \ - { \ - const unsigned char *p0 = (p); \ - const unsigned char *p_limit = max (limit, p0 - MAX_MULTIBYTE_LENGTH);\ - do { \ - p0--; \ - } while (p0 >= p_limit && ! CHAR_HEAD_P (*p0)); \ - /* If BBCH(*p0) > p-p0, it means we were not on a boundary. */ \ - (p) = (BYTES_BY_CHAR_HEAD (*p0) >= (p) - p0) ? p0 : (p) - 1; \ - } \ + if (!SYMBOLP (x) || NILP (attr = CHARSET_SYMBOL_ATTRIBUTES (x))) \ + x = wrong_type_argument (Qcharsetp, (x)); \ } while (0) -#define AT_CHAR_BOUNDARY_P(result, p, limit) \ + +#define CHECK_CHARSET_GET_CHARSET(x, charset) \ do { \ - if (CHAR_HEAD_P (*(p)) || (p) <= limit) \ - /* Optimization for the common case. */ \ - (result) = 1; \ - else \ - { \ - const unsigned char *p_aux = (p)+1; \ - PREV_CHAR_BOUNDARY (p_aux, limit); \ - (result) = (p_aux == (p)); \ - } \ -} while (0) - -#ifdef emacs - -/* Increase the buffer byte position POS_BYTE of the current buffer to - the next character boundary. This macro relies on the fact that - *GPT_ADDR and *Z_ADDR are always accessible and the values are - '\0'. No range checking of POS. */ - -#ifdef BYTE_COMBINING_DEBUG - -#define INC_POS(pos_byte) \ - do { \ - unsigned char *p = BYTE_POS_ADDR (pos_byte); \ - if (BASE_LEADING_CODE_P (*p)) \ - { \ - int len, bytes; \ - len = Z_BYTE - pos_byte; \ - PARSE_MULTIBYTE_SEQ (p, len, bytes); \ - pos_byte += bytes; \ - } \ - else \ - pos_byte++; \ + int id; \ + CHECK_CHARSET_GET_ID (x, id); \ + charset = CHARSET_FROM_ID (id); \ } while (0) -#else /* not BYTE_COMBINING_DEBUG */ -#define INC_POS(pos_byte) \ - do { \ - unsigned char *p = BYTE_POS_ADDR (pos_byte); \ - pos_byte += BYTES_BY_CHAR_HEAD (*p); \ - } while (0) +/* Lookup Vcharset_order_list and return the first charset that + contains the character C. */ +#define CHAR_CHARSET(c) \ + ((c) < 0x80 ? CHARSET_FROM_ID (charset_ascii) \ + : char_charset ((c), Qnil, NULL)) -#endif /* not BYTE_COMBINING_DEBUG */ +#if 0 +/* Char-table of charset-sets. Each element is a bool vector indexed + by a charset ID. */ +extern Lisp_Object Vchar_charset_set; -/* Decrease the buffer byte position POS_BYTE of the current buffer to - the previous character boundary. No range checking of POS. */ -#define DEC_POS(pos_byte) \ - do { \ - unsigned char *p, *p_min; \ - \ - pos_byte--; \ - if (pos_byte < GPT_BYTE) \ - p = BEG_ADDR + pos_byte - BEG_BYTE, p_min = BEG_ADDR; \ - else \ - p = BEG_ADDR + GAP_SIZE + pos_byte - BEG_BYTE, p_min = GAP_END_ADDR;\ - if (p > p_min && !CHAR_HEAD_P (*p)) \ - { \ - unsigned char *pend = p--; \ - int len, bytes; \ - if (p_min < p - MAX_MULTIBYTE_LENGTH) \ - p_min = p - MAX_MULTIBYTE_LENGTH; \ - while (p > p_min && !CHAR_HEAD_P (*p)) p--; \ - len = pend + 1 - p; \ - PARSE_MULTIBYTE_SEQ (p, len, bytes); \ - if (bytes == len) \ - pos_byte -= len - 1; \ - } \ - } while (0) +/* Charset-bag of character C. */ +#define CHAR_CHARSET_SET(c) \ + CHAR_TABLE_REF (Vchar_charset_set, c) -/* Increment both CHARPOS and BYTEPOS, each in the appropriate way. */ +/* Check if two characters C1 and C2 belong to the same charset. */ +#define SAME_CHARSET_P(c1, c2) \ + intersection_p (CHAR_CHARSET_SET (c1), CHAR_CHARSET_SET (c2)) + +#endif + + +/* Return a character correponding to the code-point CODE of CHARSET. + Try some optimization before calling decode_char. */ + +#define DECODE_CHAR(charset, code) \ + ((ASCII_BYTE_P (code) && (charset)->ascii_compatible_p) \ + ? (code) \ + : ((code) < (charset)->min_code || (code) > (charset)->max_code) \ + ? -1 \ + : (charset)->unified_p \ + ? decode_char ((charset), (code)) \ + : (charset)->method == CHARSET_METHOD_OFFSET \ + ? ((charset)->code_linear_p \ + ? (code) - (charset)->min_code + (charset)->code_offset \ + : decode_char ((charset), (code))) \ + : (charset)->method == CHARSET_METHOD_MAP \ + ? ((charset)->code_linear_p \ + ? XINT (AREF (CHARSET_DECODER (charset), \ + (code) - (charset)->min_code)) \ + : decode_char ((charset), (code))) \ + : decode_char ((charset), (code))) + + +/* If CHARSET is a simple offset base charset, return it's offset, + otherwise return -1. */ +#define CHARSET_OFFSET(charset) \ + (((charset)->method == CHARSET_METHOD_OFFSET \ + && (charset)->code_linear_p \ + && ! (charset)->unified_p) \ + ? (charset)->code_offset - (charset)->min_code \ + : -1) + +extern Lisp_Object charset_work; + +/* Return a code point of CHAR in CHARSET. + Try some optimization before calling encode_char. */ + +#define ENCODE_CHAR(charset, c) \ + ((ASCII_CHAR_P (c) && (charset)->ascii_compatible_p) \ + ? (c) \ + : ((charset)->unified_p \ + || (charset)->method == CHARSET_METHOD_SUBSET \ + || (charset)->method == CHARSET_METHOD_SUPERSET) \ + ? encode_char ((charset), (c)) \ + : ((c) < (charset)->min_char || (c) > (charset)->max_char) \ + ? (charset)->invalid_code \ + : (charset)->method == CHARSET_METHOD_OFFSET \ + ? ((charset)->code_linear_p \ + ? (c) - (charset)->code_offset + (charset)->min_code \ + : encode_char ((charset), (c))) \ + : (charset)->method == CHARSET_METHOD_MAP \ + ? ((charset)->compact_codes_p \ + ? (charset_work = CHAR_TABLE_REF (CHARSET_ENCODER (charset), (c)), \ + (NILP (charset_work) \ + ? (charset)->invalid_code \ + : XFASTINT (charset_work))) \ + : encode_char ((charset), (c))) \ + : encode_char ((charset), (c))) + + +/* Set to 1 when a charset map is loaded to warn that a buffer text + and a string data may be relocated. */ +extern int charset_map_loaded; + + +/* Set CHARSET to the charset highest priority of C, CODE to the + code-point of C in CHARSET. */ +#define SPLIT_CHAR(c, charset, code) \ + ((charset) = char_charset ((c), Qnil, &(code))) + + +#define ISO_MAX_DIMENSION 3 +#define ISO_MAX_CHARS 2 +#define ISO_MAX_FINAL 0x80 /* only 0x30..0xFF are used */ -#define INC_BOTH(charpos, bytepos) \ -do \ - { \ - (charpos)++; \ - if (NILP (current_buffer->enable_multibyte_characters)) \ - (bytepos)++; \ - else \ - INC_POS ((bytepos)); \ - } \ -while (0) - -/* Decrement both CHARPOS and BYTEPOS, each in the appropriate way. */ - -#define DEC_BOTH(charpos, bytepos) \ -do \ - { \ - (charpos)--; \ - if (NILP (current_buffer->enable_multibyte_characters)) \ - (bytepos)--; \ - else \ - DEC_POS ((bytepos)); \ - } \ -while (0) +/* Mapping table from ISO2022's charset (specified by DIMENSION, + CHARS, and FINAL_CHAR) to Emacs' charset ID. Should be accessed by + macro ISO_CHARSET_TABLE (DIMENSION, CHARS, FINAL_CHAR). */ +extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL]; -/* Increase the buffer byte position POS_BYTE of the current buffer to - the next character boundary. This macro relies on the fact that - *GPT_ADDR and *Z_ADDR are always accessible and the values are - '\0'. No range checking of POS_BYTE. */ +/* A charset of type iso2022 who has DIMENSION, CHARS, and FINAL + (final character). */ +#define ISO_CHARSET_TABLE(dimension, chars_96, final) \ + iso_charset_table[(dimension) - 1][(chars_96)][(final)] -#ifdef BYTE_COMBINING_DEBUG +/* Nonzero if the charset who has FAST_MAP may contain C. */ +#define CHARSET_FAST_MAP_REF(c, fast_map) \ + ((c) < 0x10000 \ + ? fast_map[(c) >> 10] & (1 << (((c) >> 7) & 7)) \ + : fast_map[((c) >> 15) + 62] & (1 << (((c) >> 12) & 7))) -#define BUF_INC_POS(buf, pos_byte) \ +#define CHARSET_FAST_MAP_SET(c, fast_map) \ do { \ - unsigned char *p = BUF_BYTE_ADDRESS (buf, pos_byte); \ - if (BASE_LEADING_CODE_P (*p)) \ - { \ - int len, bytes; \ - len = BUF_Z_BYTE (buf) - pos_byte; \ - PARSE_MULTIBYTE_SEQ (p, len, bytes); \ - pos_byte += bytes; \ - } \ + if ((c) < 0x10000) \ + (fast_map)[(c) >> 10] |= 1 << (((c) >> 7) & 7); \ else \ - pos_byte++; \ + (fast_map)[((c) >> 15) + 62] |= 1 << (((c) >> 12) & 7); \ } while (0) -#else /* not BYTE_COMBINING_DEBUG */ -#define BUF_INC_POS(buf, pos_byte) \ - do { \ - unsigned char *p = BUF_BYTE_ADDRESS (buf, pos_byte); \ - pos_byte += BYTES_BY_CHAR_HEAD (*p); \ - } while (0) -#endif /* not BYTE_COMBINING_DEBUG */ +/* 1 if CHARSET may contain the character C. */ +#define CHAR_CHARSET_P(c, charset) \ + ((ASCII_CHAR_P (c) && (charset)->ascii_compatible_p) \ + || ((CHARSET_UNIFIED_P (charset) \ + || (charset)->method == CHARSET_METHOD_SUBSET \ + || (charset)->method == CHARSET_METHOD_SUPERSET) \ + ? encode_char ((charset), (c)) != (charset)->invalid_code \ + : (CHARSET_FAST_MAP_REF ((c), (charset)->fast_map) \ + && ((charset)->method == CHARSET_METHOD_OFFSET \ + ? (c) >= (charset)->min_char && (c) <= (charset)->max_char \ + : ((charset)->method == CHARSET_METHOD_MAP \ + && (charset)->compact_codes_p) \ + ? ! NILP (CHAR_TABLE_REF (CHARSET_ENCODER (charset), (c))) \ + : encode_char ((charset), (c)) != (charset)->invalid_code)))) -/* Decrease the buffer byte position POS_BYTE of the current buffer to - the previous character boundary. No range checking of POS_BYTE. */ -#define BUF_DEC_POS(buf, pos_byte) \ - do { \ - unsigned char *p, *p_min; \ - pos_byte--; \ - if (pos_byte < BUF_GPT_BYTE (buf)) \ - { \ - p = BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE; \ - p_min = BUF_BEG_ADDR (buf); \ - } \ - else \ - { \ - p = BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + pos_byte - BEG_BYTE;\ - p_min = BUF_GAP_END_ADDR (buf); \ - } \ - if (p > p_min && !CHAR_HEAD_P (*p)) \ - { \ - unsigned char *pend = p--; \ - int len, bytes; \ - if (p_min < p - MAX_MULTIBYTE_LENGTH) \ - p_min = p - MAX_MULTIBYTE_LENGTH; \ - while (p > p_min && !CHAR_HEAD_P (*p)) p--; \ - len = pend + 1 - p; \ - PARSE_MULTIBYTE_SEQ (p, len, bytes); \ - if (bytes == len) \ - pos_byte -= len - 1; \ - } \ - } while (0) + +/* Special macros for emacs-mule encoding. */ -#endif /* emacs */ - -/* This is the maximum byte length of multi-byte sequence. */ -#define MAX_MULTIBYTE_LENGTH 4 - -extern void invalid_character P_ ((int)) NO_RETURN; - -extern int translate_char P_ ((Lisp_Object, int, int, int, int)); -extern int split_string P_ ((const unsigned char *, int, int *, - unsigned char *, unsigned char *)); -extern int char_to_string P_ ((int, unsigned char *)); -extern int char_to_string_1 P_ ((int, unsigned char *)); -extern int string_to_char P_ ((const unsigned char *, int, int *)); -extern int char_printable_p P_ ((int c)); -extern int multibyte_form_length P_ ((const unsigned char *, int)); -extern void parse_str_as_multibyte P_ ((const unsigned char *, int, int *, - int *)); -extern int str_as_multibyte P_ ((unsigned char *, int, int, int *)); -extern int parse_str_to_multibyte P_ ((unsigned char *, int)); -extern int str_to_multibyte P_ ((unsigned char *, int, int)); -extern int str_as_unibyte P_ ((unsigned char *, int)); -extern int get_charset_id P_ ((Lisp_Object)); -extern int find_charset_in_text P_ ((const unsigned char *, int, int, int *, - Lisp_Object)); -extern int strwidth P_ ((unsigned char *, int)); -extern int c_string_width P_ ((const unsigned char *, int, int, int *, int *)); -extern int lisp_string_width P_ ((Lisp_Object, int, int *, int *)); -extern int char_bytes P_ ((int)); -extern int char_valid_p P_ ((int, int)); - -EXFUN (Funibyte_char_to_multibyte, 1); - -extern Lisp_Object Vtranslation_table_vector; - -/* Return a translation table of id number ID. */ -#define GET_TRANSLATION_TABLE(id) \ - (XCDR(XVECTOR(Vtranslation_table_vector)->contents[(id)])) - -/* A char-table for characters which may invoke auto-filling. */ -extern Lisp_Object Vauto_fill_chars; - -/* Copy LEN bytes from FROM to TO. This macro should be used only - when a caller knows that LEN is short and the obvious copy loop is - faster than calling bcopy which has some overhead. Copying a - multibyte sequence of a multibyte character is the typical case. */ - -#define BCOPY_SHORT(from, to, len) \ - do { \ - int i = len; \ - const unsigned char *from_p = from; \ - unsigned char *to_p = to; \ - while (i--) *to_p++ = *from_p++; \ - } while (0) +/* Leading-code followed by extended leading-code. DIMENSION/COLUMN */ +#define EMACS_MULE_LEADING_CODE_PRIVATE_11 0x9A /* 1/1 */ +#define EMACS_MULE_LEADING_CODE_PRIVATE_12 0x9B /* 1/2 */ +#define EMACS_MULE_LEADING_CODE_PRIVATE_21 0x9C /* 2/2 */ +#define EMACS_MULE_LEADING_CODE_PRIVATE_22 0x9D /* 2/2 */ + +extern struct charset *emacs_mule_charset[256]; + + + +extern Lisp_Object Qcharsetp; + +extern Lisp_Object Qascii, Qunicode; +extern int charset_ascii, charset_eight_bit; +extern int charset_iso_8859_1; +extern int charset_unicode; +extern int charset_jisx0201_roman; +extern int charset_jisx0208_1978; +extern int charset_jisx0208; + +extern int charset_unibyte; + +extern struct charset *char_charset P_ ((int, Lisp_Object, unsigned *)); +extern Lisp_Object charset_attributes P_ ((int)); + +extern int decode_char P_ ((struct charset *, unsigned)); +extern unsigned encode_char P_ ((struct charset *, int)); +extern int string_xstring_p P_ ((Lisp_Object)); + +extern void map_charset_chars P_ ((void (*) (Lisp_Object, Lisp_Object), + Lisp_Object, Lisp_Object, + struct charset *, unsigned, unsigned)); + +EXFUN (Funify_charset, 3); #endif /* EMACS_CHARSET_H */ diff --git a/src/chartab.c b/src/chartab.c new file mode 100644 index 00000000000..5306e22cefc --- /dev/null +++ b/src/chartab.c @@ -0,0 +1,1048 @@ +/* chartab.c -- char-table support + Copyright (C) 2003 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include <config.h> +#include "lisp.h" +#include "character.h" +#include "charset.h" +#include "ccl.h" + +/* 64/16/32/128 */ + +/* Number of elements in Nth level char-table. */ +const int chartab_size[4] = + { (1 << CHARTAB_SIZE_BITS_0), + (1 << CHARTAB_SIZE_BITS_1), + (1 << CHARTAB_SIZE_BITS_2), + (1 << CHARTAB_SIZE_BITS_3) }; + +/* Number of characters each element of Nth level char-table + covers. */ +const int chartab_chars[4] = + { (1 << (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)), + (1 << (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3)), + (1 << CHARTAB_SIZE_BITS_3), + 1 }; + +/* Number of characters (in bits) each element of Nth level char-table + covers. */ +const int chartab_bits[4] = + { (CHARTAB_SIZE_BITS_1 + CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3), + (CHARTAB_SIZE_BITS_2 + CHARTAB_SIZE_BITS_3), + CHARTAB_SIZE_BITS_3, + 0 }; + +#define CHARTAB_IDX(c, depth, min_char) \ + (((c) - (min_char)) >> chartab_bits[(depth)]) + + +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. + +PURPOSE should be a symbol. If it has a `char-table-extra-slots' +property, the property's value should be an integer between 0 and 10 +that specifies how many extra slots the char-table has. Otherwise, +the char-table has no extra slot. */) + (purpose, init) + register Lisp_Object purpose, init; +{ + Lisp_Object vector; + Lisp_Object n; + int n_extras; + int size; + + CHECK_SYMBOL (purpose); + n = Fget (purpose, Qchar_table_extra_slots); + if (NILP (n)) + n_extras = 0; + else + { + CHECK_NATNUM (n); + n_extras = XINT (n); + if (n_extras > 10) + args_out_of_range (n, Qnil); + } + + size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras; + vector = Fmake_vector (make_number (size), init); + XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE); + XCHAR_TABLE (vector)->parent = Qnil; + XCHAR_TABLE (vector)->purpose = purpose; + XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); + return vector; +} + +static Lisp_Object +make_sub_char_table (depth, min_char, defalt) + int depth, min_char; + Lisp_Object defalt; +{ + Lisp_Object table; + int size = VECSIZE (struct Lisp_Sub_Char_Table) - 1 + chartab_size[depth]; + + table = Fmake_vector (make_number (size), defalt); + XSETPVECTYPE (XVECTOR (table), PVEC_SUB_CHAR_TABLE); + XSUB_CHAR_TABLE (table)->depth = make_number (depth); + XSUB_CHAR_TABLE (table)->min_char = make_number (min_char); + XSETSUB_CHAR_TABLE (table, XSUB_CHAR_TABLE (table)); + + return table; +} + +static Lisp_Object +char_table_ascii (table) + Lisp_Object table; +{ + Lisp_Object sub; + + sub = XCHAR_TABLE (table)->contents[0]; + if (! SUB_CHAR_TABLE_P (sub)) + return sub; + sub = XSUB_CHAR_TABLE (sub)->contents[0]; + if (! SUB_CHAR_TABLE_P (sub)) + return sub; + return XSUB_CHAR_TABLE (sub)->contents[0]; +} + +Lisp_Object +copy_sub_char_table (table) + Lisp_Object table; +{ + Lisp_Object copy; + int depth = XINT (XSUB_CHAR_TABLE (table)->depth); + int min_char = XINT (XSUB_CHAR_TABLE (table)->min_char); + Lisp_Object val; + int i; + + copy = make_sub_char_table (depth, min_char, Qnil); + /* Recursively copy any sub char-tables. */ + for (i = 0; i < chartab_size[depth]; i++) + { + val = XSUB_CHAR_TABLE (table)->contents[i]; + if (SUB_CHAR_TABLE_P (val)) + XSUB_CHAR_TABLE (copy)->contents[i] = copy_sub_char_table (val); + else + XSUB_CHAR_TABLE (copy)->contents[i] = val; + } + + return copy; +} + + +Lisp_Object +copy_char_table (table) + Lisp_Object table; +{ + Lisp_Object copy; + int size = XCHAR_TABLE (table)->size & PSEUDOVECTOR_SIZE_MASK; + int i; + + copy = Fmake_vector (make_number (size), Qnil); + XSETPVECTYPE (XVECTOR (copy), PVEC_CHAR_TABLE); + XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (table)->defalt; + XCHAR_TABLE (copy)->parent = XCHAR_TABLE (table)->parent; + XCHAR_TABLE (copy)->purpose = XCHAR_TABLE (table)->purpose; + XCHAR_TABLE (copy)->ascii = XCHAR_TABLE (table)->ascii; + for (i = 0; i < chartab_size[0]; i++) + XCHAR_TABLE (copy)->contents[i] + = (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i]) + ? copy_sub_char_table (XCHAR_TABLE (table)->contents[i]) + : XCHAR_TABLE (table)->contents[i]); + if (SUB_CHAR_TABLE_P (XCHAR_TABLE (copy)->ascii)) + XCHAR_TABLE (copy)->ascii = char_table_ascii (copy); + size -= VECSIZE (struct Lisp_Char_Table) - 1; + for (i = 0; i < size; i++) + XCHAR_TABLE (copy)->extras[i] = XCHAR_TABLE (table)->extras[i]; + + XSETCHAR_TABLE (copy, XCHAR_TABLE (copy)); + return copy; +} + +Lisp_Object +sub_char_table_ref (table, c) + Lisp_Object table; + int c; +{ + 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; + + val = tbl->contents[CHARTAB_IDX (c, depth, min_char)]; + if (SUB_CHAR_TABLE_P (val)) + val = sub_char_table_ref (val, c); + return val; +} + +Lisp_Object +char_table_ref (table, c) + Lisp_Object table; + int c; +{ + struct Lisp_Char_Table *tbl = XCHAR_TABLE (table); + Lisp_Object val; + + if (ASCII_CHAR_P (c)) + { + val = tbl->ascii; + if (SUB_CHAR_TABLE_P (val)) + val = XSUB_CHAR_TABLE (val)->contents[c]; + } + else + { + val = tbl->contents[CHARTAB_IDX (c, 0, 0)]; + if (SUB_CHAR_TABLE_P (val)) + val = sub_char_table_ref (val, c); + } + if (NILP (val)) + { + val = tbl->defalt; + if (NILP (val) && CHAR_TABLE_P (tbl->parent)) + val = char_table_ref (tbl->parent, c); + } + return val; +} + +static Lisp_Object +sub_char_table_ref_and_range (table, c, from, to, defalt) + Lisp_Object table; + int c; + int *from, *to; + Lisp_Object defalt; +{ + struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); + int depth = XINT (tbl->depth); + int min_char = XINT (tbl->min_char); + int max_char = min_char + chartab_chars[depth - 1] - 1; + int index = CHARTAB_IDX (c, depth, min_char); + Lisp_Object val; + + val = tbl->contents[index]; + *from = min_char + index * chartab_chars[depth]; + *to = *from + chartab_chars[depth] - 1; + if (SUB_CHAR_TABLE_P (val)) + val = sub_char_table_ref_and_range (val, c, from, to, defalt); + else if (NILP (val)) + val = defalt; + + while (*from > min_char + && *from == min_char + index * chartab_chars[depth]) + { + Lisp_Object this_val; + int this_from = *from - chartab_chars[depth]; + int this_to = *from - 1; + + index--; + this_val = tbl->contents[index]; + if (SUB_CHAR_TABLE_P (this_val)) + this_val = sub_char_table_ref_and_range (this_val, this_to, + &this_from, &this_to, + defalt); + else if (NILP (this_val)) + this_val = defalt; + + if (! EQ (this_val, val)) + break; + *from = this_from; + } + index = CHARTAB_IDX (c, depth, min_char); + while (*to < max_char + && *to == min_char + (index + 1) * chartab_chars[depth] - 1) + { + Lisp_Object this_val; + int this_from = *to + 1; + int this_to = this_from + chartab_chars[depth] - 1; + + index++; + this_val = tbl->contents[index]; + if (SUB_CHAR_TABLE_P (this_val)) + this_val = sub_char_table_ref_and_range (this_val, this_from, + &this_from, &this_to, + defalt); + else if (NILP (this_val)) + this_val = defalt; + if (! EQ (this_val, val)) + break; + *to = this_to; + } + + return val; +} + + +/* Return the value for C in char-table TABLE. Set *FROM and *TO to + the range of characters (containing C) that have the same value as + C. It is not assured that the value of (*FROM - 1) and (*TO + 1) + is different from that of C. */ + +Lisp_Object +char_table_ref_and_range (table, c, from, to) + Lisp_Object table; + int c; + int *from, *to; +{ + struct Lisp_Char_Table *tbl = XCHAR_TABLE (table); + int index = CHARTAB_IDX (c, 0, 0); + Lisp_Object val; + + val = tbl->contents[index]; + *from = index * chartab_chars[0]; + *to = *from + chartab_chars[0] - 1; + if (SUB_CHAR_TABLE_P (val)) + val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt); + else if (NILP (val)) + val = tbl->defalt; + + while (*from > 0 && *from == index * chartab_chars[0]) + { + Lisp_Object this_val; + int this_from = *from - chartab_chars[0]; + int this_to = *from - 1; + + index--; + this_val = tbl->contents[index]; + if (SUB_CHAR_TABLE_P (this_val)) + this_val = sub_char_table_ref_and_range (this_val, this_to, + &this_from, &this_to, + tbl->defalt); + else if (NILP (this_val)) + this_val = tbl->defalt; + + if (! EQ (this_val, val)) + break; + *from = this_from; + } + while (*to < MAX_CHAR && *to == (index + 1) * chartab_chars[0] - 1) + { + Lisp_Object this_val; + int this_from = *to + 1; + int this_to = this_from + chartab_chars[0] - 1; + + index++; + this_val = tbl->contents[index]; + if (SUB_CHAR_TABLE_P (this_val)) + this_val = sub_char_table_ref_and_range (this_val, this_from, + &this_from, &this_to, + tbl->defalt); + else if (NILP (this_val)) + this_val = tbl->defalt; + if (! EQ (this_val, val)) + break; + *to = this_to; + } + + return val; +} + + +#define ASET_RANGE(ARRAY, FROM, TO, LIMIT, VAL) \ + do { \ + int limit = (TO) < (LIMIT) ? (TO) : (LIMIT); \ + for (; (FROM) < limit; (FROM)++) (ARRAY)->contents[(FROM)] = (VAL); \ + } while (0) + +#define GET_SUB_CHAR_TABLE(TABLE, SUBTABLE, IDX, DEPTH, MIN_CHAR) \ + do { \ + (SUBTABLE) = (TABLE)->contents[(IDX)]; \ + if (!SUB_CHAR_TABLE_P (SUBTABLE)) \ + (SUBTABLE) = make_sub_char_table ((DEPTH), (MIN_CHAR), (SUBTABLE)); \ + } while (0) + + +static void +sub_char_table_set (table, c, val) + Lisp_Object table; + int c; + Lisp_Object val; +{ + struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); + int depth = XINT ((tbl)->depth); + int min_char = XINT ((tbl)->min_char); + int i = CHARTAB_IDX (c, depth, min_char); + Lisp_Object sub; + + if (depth == 3) + tbl->contents[i] = val; + else + { + 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; + } + sub_char_table_set (sub, c, val); + } +} + +Lisp_Object +char_table_set (table, c, val) + Lisp_Object table; + int c; + Lisp_Object val; +{ + struct Lisp_Char_Table *tbl = XCHAR_TABLE (table); + + if (ASCII_CHAR_P (c) + && SUB_CHAR_TABLE_P (tbl->ascii)) + { + XSUB_CHAR_TABLE (tbl->ascii)->contents[c] = val; + } + else + { + int i = CHARTAB_IDX (c, 0, 0); + Lisp_Object sub; + + 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 (sub, c, val); + if (ASCII_CHAR_P (c)) + tbl->ascii = char_table_ascii (table); + } + return val; +} + +static void +sub_char_table_set_range (table, depth, min_char, from, to, val) + Lisp_Object *table; + int depth; + int min_char; + int from, to; + Lisp_Object val; +{ + int max_char = min_char + chartab_chars[depth] - 1; + + if (depth == 3 || (from <= min_char && to >= max_char)) + *table = val; + else + { + int i, 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 (; 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); + } +} + + +Lisp_Object +char_table_set_range (table, from, to, val) + Lisp_Object table; + int from, to; + Lisp_Object val; +{ + struct Lisp_Char_Table *tbl = XCHAR_TABLE (table); + Lisp_Object *contents = tbl->contents; + int i, min_char; + + if (from == to) + char_table_set (table, from, val); + else + { + for (i = CHARTAB_IDX (from, 0, 0), min_char = i * chartab_chars[0]; + min_char <= to; + i++, min_char += chartab_chars[0]) + sub_char_table_set_range (contents + i, 0, min_char, from, to, val); + if (ASCII_CHAR_P (from)) + tbl->ascii = char_table_ascii (table); + } + return val; +} + + +DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype, + 1, 1, 0, + doc: /* +Return the subtype of char-table CHAR-TABLE. The value is a symbol. */) + (char_table) + Lisp_Object char_table; +{ + CHECK_CHAR_TABLE (char_table); + + return XCHAR_TABLE (char_table)->purpose; +} + +DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent, + 1, 1, 0, + doc: /* Return the parent char-table of CHAR-TABLE. +The value is either nil or another char-table. +If CHAR-TABLE holds nil for a given character, +then the actual applicable value is inherited from the parent char-table +\(or from its parents, if necessary). */) + (char_table) + Lisp_Object char_table; +{ + CHECK_CHAR_TABLE (char_table); + + return XCHAR_TABLE (char_table)->parent; +} + +DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent, + 2, 2, 0, + doc: /* Set the parent char-table of CHAR-TABLE to PARENT. +Return PARENT. PARENT must be either nil or another char-table. */) + (char_table, parent) + Lisp_Object char_table, parent; +{ + Lisp_Object temp; + + CHECK_CHAR_TABLE (char_table); + + if (!NILP (parent)) + { + CHECK_CHAR_TABLE (parent); + + for (temp = parent; !NILP (temp); temp = XCHAR_TABLE (temp)->parent) + if (EQ (temp, char_table)) + error ("Attempt to make a chartable be its own parent"); + } + + XCHAR_TABLE (char_table)->parent = parent; + + return parent; +} + +DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot, + 2, 2, 0, + doc: /* Return the value of CHAR-TABLE's extra-slot number N. */) + (char_table, n) + Lisp_Object char_table, n; +{ + CHECK_CHAR_TABLE (char_table); + CHECK_NUMBER (n); + if (XINT (n) < 0 + || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) + args_out_of_range (char_table, n); + + return XCHAR_TABLE (char_table)->extras[XINT (n)]; +} + +DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, + Sset_char_table_extra_slot, + 3, 3, 0, + doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */) + (char_table, n, value) + Lisp_Object char_table, n, value; +{ + CHECK_CHAR_TABLE (char_table); + CHECK_NUMBER (n); + if (XINT (n) < 0 + || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) + args_out_of_range (char_table, n); + + return XCHAR_TABLE (char_table)->extras[XINT (n)] = value; +} + +DEFUN ("char-table-range", Fchar_table_range, Schar_table_range, + 2, 2, 0, + doc: /* Return the value in CHAR-TABLE for a range of characters RANGE. +RANGE should be nil (for the default value), +a cons of character codes (for characters in the range), or a character code. */) + (char_table, range) + Lisp_Object char_table, range; +{ + Lisp_Object val; + CHECK_CHAR_TABLE (char_table); + + if (EQ (range, Qnil)) + val = XCHAR_TABLE (char_table)->defalt; + else if (INTEGERP (range)) + val = CHAR_TABLE_REF (char_table, XINT (range)); + else if (CONSP (range)) + { + int from, to; + + CHECK_CHARACTER_CAR (range); + CHECK_CHARACTER_CDR (range); + val = char_table_ref_and_range (char_table, XINT (XCAR (range)), + &from, &to); + /* Not yet implemented. */ + } + else + error ("Invalid RANGE argument to `char-table-range'"); + return val; +} + +DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range, + 3, 3, 0, + doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE. +RANGE should be t (for all characters), nil (for the default value), +a cons of character codes (for characters in the range), +or a character code. Return VALUE. */) + (char_table, range, value) + Lisp_Object char_table, range, value; +{ + CHECK_CHAR_TABLE (char_table); + if (EQ (range, Qt)) + { + int i; + + XCHAR_TABLE (char_table)->ascii = Qnil; + for (i = 0; i < chartab_size[0]; i++) + XCHAR_TABLE (char_table)->contents[i] = Qnil; + XCHAR_TABLE (char_table)->defalt = value; + } + else if (EQ (range, Qnil)) + XCHAR_TABLE (char_table)->defalt = value; + else if (INTEGERP (range)) + char_table_set (char_table, XINT (range), value); + else if (CONSP (range)) + { + CHECK_CHARACTER_CAR (range); + CHECK_CHARACTER_CDR (range); + char_table_set_range (char_table, + XINT (XCAR (range)), XINT (XCDR (range)), value); + } + else + error ("Invalid RANGE argument to `set-char-table-range'"); + + return value; +} + +DEFUN ("set-char-table-default", Fset_char_table_default, + Sset_char_table_default, 3, 3, 0, + doc: /* +This function is obsolete and has no effect. */) + (char_table, ch, value) + Lisp_Object char_table, ch, value; +{ + return Qnil; +} + +/* Look up the element in TABLE at index CH, and return it as an + integer. If the element is not a character, return CH itself. */ + +int +char_table_translate (table, ch) + Lisp_Object table; + int ch; +{ + Lisp_Object value; + value = Faref (table, make_number (ch)); + if (! CHARACTERP (value)) + return ch; + return XINT (value); +} + +static Lisp_Object +optimize_sub_char_table (table) + Lisp_Object table; +{ + struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); + int depth = XINT (tbl->depth); + Lisp_Object elt, this; + int i; + + elt = XSUB_CHAR_TABLE (table)->contents[0]; + if (SUB_CHAR_TABLE_P (elt)) + elt = XSUB_CHAR_TABLE (table)->contents[0] = optimize_sub_char_table (elt); + if (SUB_CHAR_TABLE_P (elt)) + return table; + for (i = 1; i < chartab_size[depth]; i++) + { + this = XSUB_CHAR_TABLE (table)->contents[i]; + if (SUB_CHAR_TABLE_P (this)) + this = XSUB_CHAR_TABLE (table)->contents[i] + = optimize_sub_char_table (this); + if (SUB_CHAR_TABLE_P (this) + || NILP (Fequal (this, elt))) + break; + } + + return (i < chartab_size[depth] ? table : elt); +} + +DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table, + 1, 1, 0, + doc: /* Optimize CHAR-TABLE. */) + (char_table) + Lisp_Object char_table; +{ + Lisp_Object elt; + int i; + + CHECK_CHAR_TABLE (char_table); + + for (i = 0; i < chartab_size[0]; i++) + { + elt = XCHAR_TABLE (char_table)->contents[i]; + if (SUB_CHAR_TABLE_P (elt)) + XCHAR_TABLE (char_table)->contents[i] = optimize_sub_char_table (elt); + } + return Qnil; +} + + +/* 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 + char-table. + + ARG is passed to C_FUNCTION when that is called. + + It returns the value of last character covered by TABLE (not the + value inheritted from the parent), and by side-effect, the car part + of RANGE is updated to the minimum character C where C and all the + following characters in TABLE have the same value. */ + +static Lisp_Object +map_sub_char_table (c_function, function, table, arg, val, range, + default_val, parent) + void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); + Lisp_Object function, table, arg, val, range, default_val, parent; +{ + /* Pointer to the elements of TABLE. */ + Lisp_Object *contents; + /* Depth of TABLE. */ + int depth; + /* Minimum and maxinum characters covered by TABLE. */ + int min_char, max_char; + /* Number of characters covered by one element of TABLE. */ + int chars_in_block; + int from = XINT (XCAR (range)), to = XINT (XCDR (range)); + int i, c; + + if (SUB_CHAR_TABLE_P (table)) + { + struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); + + depth = XINT (tbl->depth); + contents = tbl->contents; + min_char = XINT (tbl->min_char); + max_char = min_char + chartab_chars[depth - 1] - 1; + } + else + { + depth = 0; + contents = XCHAR_TABLE (table)->contents; + min_char = 0; + max_char = MAX_CHAR; + } + chars_in_block = chartab_chars[depth]; + + if (to < max_char) + max_char = to; + /* Set I to the index of the first element to check. */ + if (from <= min_char) + i = 0; + else + i = (from - min_char) / chars_in_block; + for (c = min_char + chars_in_block * i; c <= max_char; + i++, c += chars_in_block) + { + Lisp_Object this = contents[i]; + int nextc = c + chars_in_block; + + 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); + } + else + { + if (NILP (this)) + this = default_val; + if (NILP (Fequal (val, this))) + { + int different_value = 1; + + if (NILP (val)) + { + if (! NILP (parent)) + { + Lisp_Object 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; + 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); + if (! NILP (Fequal (val, this))) + different_value = 0; + } + } + if (! NILP (val) && different_value) + { + XSETCDR (range, make_number (c - 1)); + if (EQ (XCAR (range), XCDR (range))) + { + if (c_function) + (*c_function) (arg, XCAR (range), val); + else + call2 (function, XCAR (range), val); + } + else + { + if (c_function) + (*c_function) (arg, range, val); + else + call2 (function, range, val); + } + } + val = this; + from = c; + XSETCAR (range, make_number (c)); + } + } + XSETCDR (range, make_number (to)); + } + return val; +} + + +/* Map C_FUNCTION or FUNCTION over TABLE, calling it for each + character or group of characters that share a value. + + ARG is passed to C_FUNCTION when that is called. */ + +void +map_char_table (c_function, function, table, arg) + void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); + Lisp_Object function, table, arg; +{ + Lisp_Object range, val; + int c, i; + struct gcpro gcpro1, gcpro2, gcpro3; + + range = Fcons (make_number (0), make_number (MAX_CHAR)); + GCPRO3 (table, arg, range); + 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); + /* 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; + int from = XINT (XCAR (range)); + + /* 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); + table = parent; + } + + if (! NILP (val)) + { + if (EQ (XCAR (range), XCDR (range))) + { + if (c_function) + (*c_function) (arg, XCAR (range), val); + else + call2 (function, XCAR (range), val); + } + else + { + if (c_function) + (*c_function) (arg, range, val); + else + call2 (function, range, val); + } + } + + UNGCPRO; +} + +DEFUN ("map-char-table", Fmap_char_table, Smap_char_table, + 2, 2, 0, + doc: /* +Call FUNCTION for each character in CHAR-TABLE that has non-nil value. +FUNCTION is called with two arguments--a key and a value. +The key is a character code or a cons of character codes specifying a +range of characters that have the same value. */) + (function, char_table) + Lisp_Object function, char_table; +{ + CHECK_CHAR_TABLE (char_table); + + map_char_table (NULL, function, char_table, char_table); + return Qnil; +} + + +static void +map_sub_char_table_for_charset (c_function, function, table, arg, range, + charset, from, to) + void (*c_function) P_ ((Lisp_Object, Lisp_Object)); + Lisp_Object function, table, arg, range; + struct charset *charset; + unsigned from, to; +{ + struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); + int depth = XINT (tbl->depth); + int c, i; + + if (depth < 3) + for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth]; + i++, c += chartab_chars[depth]) + { + Lisp_Object this; + + this = tbl->contents[i]; + if (SUB_CHAR_TABLE_P (this)) + map_sub_char_table_for_charset (c_function, function, this, arg, + range, charset, from, to); + else + { + if (! NILP (XCAR (range))) + { + XSETCDR (range, make_number (c - 1)); + if (c_function) + (*c_function) (arg, range); + else + call2 (function, range, arg); + } + XSETCAR (range, Qnil); + } + } + else + for (i = 0, c = XINT (tbl->min_char); i < chartab_size[depth]; i++, c ++) + { + Lisp_Object this; + unsigned code; + + this = tbl->contents[i]; + if (NILP (this) + || (charset + && (code = ENCODE_CHAR (charset, c), + (code < from || code > to)))) + { + if (! NILP (XCAR (range))) + { + XSETCDR (range, make_number (c - 1)); + if (c_function) + (*c_function) (arg, range); + else + call2 (function, range, arg); + XSETCAR (range, Qnil); + } + } + else + { + if (NILP (XCAR (range))) + XSETCAR (range, make_number (c)); + } + } +} + + +void +map_char_table_for_charset (c_function, function, table, arg, + charset, from, to) + void (*c_function) P_ ((Lisp_Object, Lisp_Object)); + Lisp_Object function, table, arg; + struct charset *charset; + unsigned from, to; +{ + Lisp_Object range; + int c, i; + struct gcpro gcpro1; + + range = Fcons (Qnil, Qnil); + GCPRO1 (range); + + for (i = 0, c = 0; i < chartab_size[0]; i++, c += chartab_chars[0]) + { + Lisp_Object this; + + this = XCHAR_TABLE (table)->contents[i]; + if (SUB_CHAR_TABLE_P (this)) + map_sub_char_table_for_charset (c_function, function, this, arg, + range, charset, from, to); + else + { + if (! NILP (XCAR (range))) + { + XSETCDR (range, make_number (c - 1)); + if (c_function) + (*c_function) (arg, range); + else + call2 (function, range, arg); + } + XSETCAR (range, Qnil); + } + } + if (! NILP (XCAR (range))) + { + XSETCDR (range, make_number (c - 1)); + if (c_function) + (*c_function) (arg, range); + else + call2 (function, range, arg); + } + + UNGCPRO; +} + + +void +syms_of_chartab () +{ + defsubr (&Smake_char_table); + defsubr (&Schar_table_parent); + defsubr (&Schar_table_subtype); + defsubr (&Sset_char_table_parent); + defsubr (&Schar_table_extra_slot); + defsubr (&Sset_char_table_extra_slot); + defsubr (&Schar_table_range); + defsubr (&Sset_char_table_range); + defsubr (&Sset_char_table_default); + defsubr (&Soptimize_char_table); + defsubr (&Smap_char_table); +} + +/* arch-tag: 18b5b560-7ab5-4108-b09e-d5dd65dc6fda + (do not change this comment) */ diff --git a/src/cmds.c b/src/cmds.c index b89074fbc5e..45b3f87fff2 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -24,7 +24,7 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "commands.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "syntax.h" #include "window.h" #include "keyboard.h" @@ -327,11 +327,11 @@ Whichever character you type to run this command is inserted. */) CHECK_NUMBER (n); /* Barf if the key that invoked this was not a character. */ - if (!INTEGERP (last_command_char)) + if (!CHARACTERP (last_command_char)) bitch_at_user (); { int character = translate_char (Vtranslation_table_for_input, - XINT (last_command_char), 0, 0, 0); + XINT (last_command_char)); if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode)) { int modified_char = character; @@ -395,7 +395,6 @@ internal_self_insert (c, noautofill) /* At first, get multi-byte form of C in STR. */ if (!NILP (current_buffer->enable_multibyte_characters)) { - c = unibyte_char_to_multibyte (c); len = CHAR_STRING (c, str); if (len == 1) /* If C has modifier bits, this makes C an appropriate @@ -472,10 +471,19 @@ internal_self_insert (c, noautofill) } hairy = 2; } + + if (NILP (current_buffer->enable_multibyte_characters)) + MAKE_CHAR_MULTIBYTE (c); + synt = SYNTAX (c); + if (!NILP (current_buffer->abbrev_mode) - && SYNTAX (c) != Sword + && synt != Sword && NILP (current_buffer->read_only) - && PT > BEGV && SYNTAX (XFASTINT (Fprevious_char ())) == Sword) + && PT > BEGV + && (!NILP (current_buffer->enable_multibyte_characters) + ? SYNTAX (XFASTINT (Fprevious_char ())) == Sword + : (SYNTAX (unibyte_char_to_multibyte (XFASTINT (Fprevious_char ()))) + == Sword))) { int modiff = MODIFF; Lisp_Object sym; @@ -544,7 +552,6 @@ internal_self_insert (c, noautofill) Vself_insert_face = Qnil; } - synt = SYNTAX (c); if ((synt == Sclose || synt == Smath) && !NILP (Vblink_paren_function) && INTERACTIVE && !noautofill) diff --git a/src/coding.c b/src/coding.c index 331b94e30a6..bca75754156 100644 --- a/src/coding.c +++ b/src/coding.c @@ -1,10 +1,13 @@ -/* Coding system handler (conversion, detection, and etc). +/* Coding system handler (conversion, detection, etc). Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -27,387 +30,329 @@ Boston, MA 02110-1301, USA. */ 0. General comments 1. Preamble - 2. Emacs' internal format (emacs-mule) handlers - 3. ISO2022 handlers - 4. Shift-JIS and BIG5 handlers - 5. CCL handlers - 6. End-of-line handlers - 7. C library functions - 8. Emacs Lisp library functions - 9. Post-amble + 2. Emacs' internal format (emacs-utf-8) handlers + 3. UTF-8 handlers + 4. UTF-16 handlers + 5. Charset-base coding systems handlers + 6. emacs-mule (old Emacs' internal format) handlers + 7. ISO2022 handlers + 8. Shift-JIS and BIG5 handlers + 9. CCL handlers + 10. C library functions + 11. Emacs Lisp library functions + 12. Postamble */ -/*** 0. General comments ***/ +/*** 0. General comments *** -/*** GENERAL NOTE on CODING SYSTEMS *** +CODING SYSTEM - A coding system is an encoding mechanism for one or more character - sets. Here's a list of coding systems which Emacs can handle. When - we say "decode", it means converting some other coding system to - Emacs' internal format (emacs-mule), and when we say "encode", - it means converting the coding system emacs-mule to some other + A coding system is an object for an encoding mechanism that contains + information about how to convert byte sequences to character + sequences and vice versa. When we say "decode", it means converting + a byte sequence of a specific coding system into a character + sequence that is represented by Emacs' internal coding system + `emacs-utf-8', and when we say "encode", it means converting a + character sequence of emacs-utf-8 to a byte sequence of a specific coding system. - 0. Emacs' internal format (emacs-mule) + In Emacs Lisp, a coding system is represented by a Lisp symbol. In + C level, a coding system is represented by a vector of attributes + stored in the hash table Vcharset_hash_table. The conversion from + coding system symbol to attributes vector is done by looking up + Vcharset_hash_table by the symbol. + + Coding systems are classified into the following types depending on + the encoding mechanism. Here's a brief description of the types. + + o UTF-8 + + o UTF-16 + + o Charset-base coding system + + A coding system defined by one or more (coded) character sets. + Decoding and encoding are done by a code converter defined for each + character set. + + o Old Emacs internal format (emacs-mule) - Emacs itself holds a multi-lingual character in buffers and strings - in a special format. Details are described in section 2. + The coding system adopted by old versions of Emacs (20 and 21). - 1. ISO2022 + o ISO2022-base coding system The most famous coding system for multiple character sets. X's - Compound Text, various EUCs (Extended Unix Code), and coding - systems used in Internet communication such as ISO-2022-JP are - all variants of ISO2022. Details are described in section 3. + Compound Text, various EUCs (Extended Unix Code), and coding systems + used in the Internet communication such as ISO-2022-JP are all + variants of ISO2022. - 2. SJIS (or Shift-JIS or MS-Kanji-Code) + o SJIS (or Shift-JIS or MS-Kanji-Code) A coding system to encode character sets: ASCII, JISX0201, and JISX0208. Widely used for PC's in Japan. Details are described in - section 4. + section 8. - 3. BIG5 + o BIG5 - A coding system to encode the character sets ASCII and Big5. Widely + A coding system to encode character sets: ASCII and Big5. Widely used for Chinese (mainly in Taiwan and Hong Kong). Details are - described in section 4. In this file, when we write "BIG5" - (all uppercase), we mean the coding system, and when we write - "Big5" (capitalized), we mean the character set. + described in section 8. In this file, when we write "big5" (all + lowercase), we mean the coding system, and when we write "Big5" + (capitalized), we mean the character set. - 4. Raw text + o CCL - A coding system for text containing random 8-bit code. Emacs does - no code conversion on such text except for end-of-line format. + If a user wants to decode/encode text encoded in a coding system + not listed above, he can supply a decoder and an encoder for it in + CCL (Code Conversion Language) programs. Emacs executes the CCL + program while decoding/encoding. - 5. Other + o Raw-text - If a user wants to read/write text encoded in a coding system not - listed above, he can supply a decoder and an encoder for it as CCL - (Code Conversion Language) programs. Emacs executes the CCL program - while reading/writing. + A coding system for text containing raw eight-bit data. Emacs + treats each byte of source text as a character (except for + end-of-line conversion). - Emacs represents a coding system by a Lisp symbol that has a property - `coding-system'. But, before actually using the coding system, the - information about it is set in a structure of type `struct - coding_system' for rapid processing. See section 6 for more details. + o No-conversion + + Like raw text, but don't do end-of-line conversion. -*/ -/*** GENERAL NOTES on END-OF-LINE FORMAT *** +END-OF-LINE FORMAT - How end-of-line of text is encoded depends on the operating system. - For instance, Unix's format is just one byte of `line-feed' code, + How text end-of-line is encoded depends on operating system. For + instance, Unix's format is just one byte of LF (line-feed) code, whereas DOS's format is two-byte sequence of `carriage-return' and `line-feed' codes. MacOS's format is usually one byte of `carriage-return'. Since text character encoding and end-of-line encoding are - independent, any coding system described above can have any - end-of-line format. So Emacs has information about end-of-line - format in each coding-system. See section 6 for more details. + independent, any coding system described above can take any format + of end-of-line (except for no-conversion). + +STRUCT CODING_SYSTEM + + Before using a coding system for code conversion (i.e. decoding and + encoding), we setup a structure of type `struct coding_system'. + This structure keeps various information about a specific code + conversion (e.g. the location of source and destination data). */ +/* COMMON MACROS */ + + /*** GENERAL NOTES on `detect_coding_XXX ()' functions *** - These functions check if a text between SRC and SRC_END is encoded - in the coding system category XXX. Each returns an integer value in - which appropriate flag bits for the category XXX are set. The flag - bits are defined in macros CODING_CATEGORY_MASK_XXX. Below is the - template for these functions. If MULTIBYTEP is nonzero, 8-bit codes - of the range 0x80..0x9F are in multibyte form. */ + These functions check if a byte sequence specified as a source in + CODING conforms to the format of XXX, and update the members of + DETECT_INFO. + + Return 1 if the byte sequence conforms to XXX, otherwise return 0. + + Below is the template of these functions. */ + #if 0 -int -detect_coding_emacs_mule (src, src_end, multibytep) - unsigned char *src, *src_end; - int multibytep; +static int +detect_coding_XXX (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; { - ... + const unsigned char *src = coding->source; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int consumed_chars = 0; + int found = 0; + ...; + + while (1) + { + /* Get one byte from the source. If the souce is exausted, jump + to no_more_source:. */ + ONE_MORE_BYTE (c); + + if (! __C_conforms_to_XXX___ (c)) + break; + if (! __C_strongly_suggests_XXX__ (c)) + found = CATEGORY_MASK_XXX; + } + /* The byte sequence is invalid for XXX. */ + detect_info->rejected |= CATEGORY_MASK_XXX; + return 0; + + no_more_source: + /* The source exausted successfully. */ + detect_info->found |= found; + return 1; } #endif /*** GENERAL NOTES on `decode_coding_XXX ()' functions *** - These functions decode SRC_BYTES length of unibyte text at SOURCE - encoded in CODING to Emacs' internal format. The resulting - multibyte text goes to a place pointed to by DESTINATION, the length - of which should not exceed DST_BYTES. + These functions decode a byte sequence specified as a source by + CODING. The resulting multibyte text goes to a place pointed to by + CODING->charbuf, the length of which should not exceed + CODING->charbuf_size; - These functions set the information about original and decoded texts - in the members `produced', `produced_char', `consumed', and - `consumed_char' of the structure *CODING. They also set the member - `result' to one of CODING_FINISH_XXX indicating how the decoding - finished. + These functions set the information of original and decoded texts in + CODING->consumed, CODING->consumed_char, and CODING->charbuf_used. + They also set CODING->result to one of CODING_RESULT_XXX indicating + how the decoding is finished. - DST_BYTES zero means that the source area and destination area are - overlapped, which means that we can produce a decoded text until it - reaches the head of the not-yet-decoded source text. + Below is the template of these functions. */ - Below is a template for these functions. */ #if 0 static void -decode_coding_XXX (coding, source, destination, src_bytes, dst_bytes) +decode_coding_XXXX (coding) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; { - ... + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; + /* SRC_BASE remembers the start position in source in each loop. + The loop will be exited when there's not enough source code, or + when there's no room in CHARBUF for a decoded character. */ + const unsigned char *src_base; + /* A buffer to produce decoded characters. */ + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end = coding->charbuf + coding->charbuf_size; + int multibytep = coding->src_multibyte; + + while (1) + { + src_base = src; + if (charbuf < charbuf_end) + /* No more room to produce a decoded character. */ + break; + ONE_MORE_BYTE (c); + /* Decode it. */ + } + + no_more_source: + if (src_base < src_end + && coding->mode & CODING_MODE_LAST_BLOCK) + /* If the source ends by partial bytes to construct a character, + treat them as eight-bit raw data. */ + while (src_base < src_end && charbuf < charbuf_end) + *charbuf++ = *src_base++; + /* Remember how many bytes and characters we consumed. If the + source is multibyte, the bytes and chars are not identical. */ + coding->consumed = coding->consumed_char = src_base - coding->source; + /* Remember how many characters we produced. */ + coding->charbuf_used = charbuf - coding->charbuf; } #endif /*** GENERAL NOTES on `encode_coding_XXX ()' functions *** - These functions encode SRC_BYTES length text at SOURCE from Emacs' - internal multibyte format to CODING. The resulting unibyte text + These functions encode SRC_BYTES length text at SOURCE of Emacs' + internal multibyte format by CODING. The resulting byte sequence goes to a place pointed to by DESTINATION, the length of which should not exceed DST_BYTES. - These functions set the information about original and encoded texts - in the members `produced', `produced_char', `consumed', and - `consumed_char' of the structure *CODING. They also set the member - `result' to one of CODING_FINISH_XXX indicating how the encoding - finished. + These functions set the information of original and encoded texts in + the members produced, produced_char, consumed, and consumed_char of + the structure *CODING. They also set the member result to one of + CODING_RESULT_XXX indicating how the encoding finished. - DST_BYTES zero means that the source area and destination area are - overlapped, which means that we can produce encoded text until it - reaches at the head of the not-yet-encoded source text. + DST_BYTES zero means that source area and destination area are + overlapped, which means that we can produce a encoded text until it + reaches at the head of not-yet-encoded source text. - Below is a template for these functions. */ + Below is a template of these functions. */ #if 0 static void -encode_coding_XXX (coding, source, destination, src_bytes, dst_bytes) +encode_coding_XXX (coding) struct coding_system *coding; - unsigned char *source, *destination; - int src_bytes, dst_bytes; { - ... + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf->charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + unsigned char *adjusted_dst_end = dst_end - _MAX_BYTES_PRODUCED_IN_LOOP_; + int produced_chars = 0; + + for (; charbuf < charbuf_end && dst < adjusted_dst_end; charbuf++) + { + int c = *charbuf; + /* Encode C into DST, and increment DST. */ + } + label_no_more_destination: + /* How many chars and bytes we produced. */ + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; } #endif -/*** COMMONLY USED MACROS ***/ - -/* The following two macros ONE_MORE_BYTE and TWO_MORE_BYTES safely - get one, two, and three bytes from the source text respectively. - If there are not enough bytes in the source, they jump to - `label_end_of_loop'. The caller should set variables `coding', - `src' and `src_end' to appropriate pointer in advance. These - macros are called from decoding routines `decode_coding_XXX', thus - it is assumed that the source text is unibyte. */ - -#define ONE_MORE_BYTE(c1) \ - do { \ - if (src >= src_end) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_SRC; \ - goto label_end_of_loop; \ - } \ - c1 = *src++; \ - } while (0) - -#define TWO_MORE_BYTES(c1, c2) \ - do { \ - if (src + 1 >= src_end) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_SRC; \ - goto label_end_of_loop; \ - } \ - c1 = *src++; \ - c2 = *src++; \ - } while (0) - - -/* Like ONE_MORE_BYTE, but 8-bit bytes of data at SRC are in multibyte - form if MULTIBYTEP is nonzero. In addition, if SRC is not less - than SRC_END, return with RET. */ - -#define ONE_MORE_BYTE_CHECK_MULTIBYTE(c1, multibytep, ret) \ - do { \ - if (src >= src_end) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_SRC; \ - return ret; \ - } \ - c1 = *src++; \ - if (multibytep && c1 == LEADING_CODE_8_BIT_CONTROL) \ - c1 = *src++ - 0x20; \ - } while (0) - -/* Set C to the next character at the source text pointed by `src'. - If there are not enough characters in the source, jump to - `label_end_of_loop'. The caller should set variables `coding' - `src', `src_end', and `translation_table' to appropriate pointers - in advance. This macro is used in encoding routines - `encode_coding_XXX', thus it assumes that the source text is in - multibyte form except for 8-bit characters. 8-bit characters are - in multibyte form if coding->src_multibyte is nonzero, else they - are represented by a single byte. */ - -#define ONE_MORE_CHAR(c) \ - do { \ - int len = src_end - src; \ - int bytes; \ - if (len <= 0) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_SRC; \ - goto label_end_of_loop; \ - } \ - if (coding->src_multibyte \ - || UNIBYTE_STR_AS_MULTIBYTE_P (src, len, bytes)) \ - c = STRING_CHAR_AND_LENGTH (src, len, bytes); \ - else \ - c = *src, bytes = 1; \ - if (!NILP (translation_table)) \ - c = translate_char (translation_table, c, -1, 0, 0); \ - src += bytes; \ - } while (0) - - -/* Produce a multibyte form of character C to `dst'. Jump to - `label_end_of_loop' if there's not enough space at `dst'. - - If we are now in the middle of a composition sequence, the decoded - character may be ALTCHAR (for the current composition). In that - case, the character goes to coding->cmp_data->data instead of - `dst'. - - This macro is used in decoding routines. */ - -#define EMIT_CHAR(c) \ - do { \ - if (! COMPOSING_P (coding) \ - || coding->composing == COMPOSITION_RELATIVE \ - || coding->composing == COMPOSITION_WITH_RULE) \ - { \ - int bytes = CHAR_BYTES (c); \ - if ((dst + bytes) > (dst_bytes ? dst_end : src)) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_DST; \ - goto label_end_of_loop; \ - } \ - dst += CHAR_STRING (c, dst); \ - coding->produced_char++; \ - } \ - \ - if (COMPOSING_P (coding) \ - && coding->composing != COMPOSITION_RELATIVE) \ - { \ - CODING_ADD_COMPOSITION_COMPONENT (coding, c); \ - coding->composition_rule_follows \ - = coding->composing != COMPOSITION_WITH_ALTCHARS; \ - } \ - } while (0) - - -#define EMIT_ONE_BYTE(c) \ - do { \ - if (dst >= (dst_bytes ? dst_end : src)) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_DST; \ - goto label_end_of_loop; \ - } \ - *dst++ = c; \ - } while (0) - -#define EMIT_TWO_BYTES(c1, c2) \ - do { \ - if (dst + 2 > (dst_bytes ? dst_end : src)) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_DST; \ - goto label_end_of_loop; \ - } \ - *dst++ = c1, *dst++ = c2; \ - } while (0) - -#define EMIT_BYTES(from, to) \ - do { \ - if (dst + (to - from) > (dst_bytes ? dst_end : src)) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_DST; \ - goto label_end_of_loop; \ - } \ - while (from < to) \ - *dst++ = *from++; \ - } while (0) - /*** 1. Preamble ***/ -#ifdef emacs #include <config.h> -#endif - #include <stdio.h> -#ifdef emacs - #include "lisp.h" #include "buffer.h" +#include "character.h" #include "charset.h" -#include "composite.h" #include "ccl.h" +#include "composite.h" #include "coding.h" #include "window.h" -#include "intervals.h" #include "frame.h" #include "termhooks.h" -#else /* not emacs */ +Lisp_Object Vcoding_system_hash_table; -#include "mulelib.h" - -#endif /* not emacs */ - -Lisp_Object Qcoding_system, Qeol_type; +Lisp_Object Qcoding_system, Qcoding_aliases, Qeol_type; +Lisp_Object Qunix, Qdos; +extern Lisp_Object Qmac; /* frame.c */ Lisp_Object Qbuffer_file_coding_system; Lisp_Object Qpost_read_conversion, Qpre_write_conversion; +Lisp_Object Qdefault_char; Lisp_Object Qno_conversion, Qundecided; +Lisp_Object Qcharset, Qiso_2022, Qutf_8, Qutf_16, Qshift_jis, Qbig5; +Lisp_Object Qbig, Qlittle; Lisp_Object Qcoding_system_history; -Lisp_Object Qsafe_chars; Lisp_Object Qvalid_codes; -Lisp_Object Qascii_incompatible; +Lisp_Object QCcategory, QCmnemonic, QCdefalut_char; +Lisp_Object QCdecode_translation_table, QCencode_translation_table; +Lisp_Object QCpost_read_conversion, QCpre_write_conversion; +Lisp_Object QCascii_compatible_p; extern Lisp_Object Qinsert_file_contents, Qwrite_region; Lisp_Object Qcall_process, Qcall_process_region; Lisp_Object Qstart_process, Qopen_network_stream; Lisp_Object Qtarget_idx; +Lisp_Object Qinsufficient_source, Qinconsistent_eol, Qinvalid_source; +Lisp_Object Qinterrupted, Qinsufficient_memory; + extern Lisp_Object Qcompletion_ignore_case; /* If a symbol has this property, evaluate the value to define the symbol as a coding system. */ -Lisp_Object Qcoding_system_define_form; - -Lisp_Object Vselect_safe_coding_system_function; +static Lisp_Object Qcoding_system_define_form; int coding_system_require_warning; +Lisp_Object Vselect_safe_coding_system_function; + /* Mnemonic string for each format of end-of-line. */ Lisp_Object eol_mnemonic_unix, eol_mnemonic_dos, eol_mnemonic_mac; /* Mnemonic string to indicate format of end-of-line is not yet decided. */ Lisp_Object eol_mnemonic_undecided; -/* Format of end-of-line decided by system. This is CODING_EOL_LF on - Unix, CODING_EOL_CRLF on DOS/Windows, and CODING_EOL_CR on Mac. +/* Format of end-of-line decided by system. This is Qunix on + Unix and Mac, Qdos on DOS/Windows. This has an effect only for external encoding (i.e. for output to file and process), not for in-buffer or Lisp string encoding. */ -int system_eol_type; +static Lisp_Object system_eol_type; #ifdef emacs -/* Information about which coding system is safe for which chars. - The value has the form (GENERIC-LIST . NON-GENERIC-ALIST). - - GENERIC-LIST is a list of generic coding systems which can encode - any characters. - - NON-GENERIC-ALIST is an alist of non generic coding systems vs the - corresponding char table that contains safe chars. */ -Lisp_Object Vcoding_system_safe_chars; - Lisp_Object Vcoding_system_list, Vcoding_system_alist; Lisp_Object Qcoding_system_p, Qcoding_system_error; @@ -415,8 +360,7 @@ Lisp_Object Qcoding_system_p, Qcoding_system_error; /* Coding system emacs-mule and raw-text are for converting only end-of-line format. */ Lisp_Object Qemacs_mule, Qraw_text; - -Lisp_Object Qutf_8; +Lisp_Object Qutf_8_emacs; /* Coding-systems are handed between Emacs Lisp programs and C internal routines by the following three variables. */ @@ -426,7 +370,8 @@ Lisp_Object Vcoding_system_for_read; Lisp_Object Vcoding_system_for_write; /* Coding-system actually used in the latest I/O. */ Lisp_Object Vlast_coding_system_used; - +/* Set to non-nil when an error is detected while code conversion. */ +Lisp_Object Vlast_code_conversion_error; /* A vector of length 256 which contains information about special Latin codes (especially for dealing with Microsoft codes). */ Lisp_Object Vlatin_extra_code_table; @@ -444,9 +389,6 @@ int inherit_process_coding_system; terminal coding system is nil. */ struct coding_system safe_terminal_coding; -/* Default coding system to be used to write a file. */ -struct coding_system default_buffer_file_coding; - Lisp_Object Vfile_coding_system_alist; Lisp_Object Vprocess_coding_system_alist; Lisp_Object Vnetwork_coding_system_alist; @@ -455,42 +397,6 @@ Lisp_Object Vlocale_coding_system; #endif /* emacs */ -Lisp_Object Qcoding_category, Qcoding_category_index; - -/* List of symbols `coding-category-xxx' ordered by priority. */ -Lisp_Object Vcoding_category_list; - -/* Table of coding categories (Lisp symbols). */ -Lisp_Object Vcoding_category_table; - -/* Table of names of symbol for each coding-category. */ -char *coding_category_name[CODING_CATEGORY_IDX_MAX] = { - "coding-category-emacs-mule", - "coding-category-sjis", - "coding-category-iso-7", - "coding-category-iso-7-tight", - "coding-category-iso-8-1", - "coding-category-iso-8-2", - "coding-category-iso-7-else", - "coding-category-iso-8-else", - "coding-category-ccl", - "coding-category-big5", - "coding-category-utf-8", - "coding-category-utf-16-be", - "coding-category-utf-16-le", - "coding-category-raw-text", - "coding-category-binary" -}; - -/* Table of pointers to coding systems corresponding to each coding - categories. */ -struct coding_system *coding_system_table[CODING_CATEGORY_IDX_MAX]; - -/* Table of coding category masks. Nth element is a mask for a coding - category of which priority is Nth. */ -static -int coding_priorities[CODING_CATEGORY_IDX_MAX]; - /* Flag to tell if we look up translation table on character code conversion. */ Lisp_Object Venable_character_translation; @@ -505,7 +411,7 @@ Lisp_Object Qtranslation_table_for_decode; Lisp_Object Qtranslation_table_for_encode; /* Alist of charsets vs revision number. */ -Lisp_Object Vcharset_revision_alist; +static Lisp_Object Vcharset_revision_table; /* Default coding systems used for process I/O. */ Lisp_Object Vdefault_process_coding_system; @@ -513,34 +419,1200 @@ Lisp_Object Vdefault_process_coding_system; /* Char table for translating Quail and self-inserting input. */ Lisp_Object Vtranslation_table_for_input; -/* Global flag to tell that we can't call post-read-conversion and - pre-write-conversion functions. Usually the value is zero, but it - is set to 1 temporarily while such functions are running. This is - to avoid infinite recursive call. */ -static int inhibit_pre_post_conversion; +/* Two special coding systems. */ +Lisp_Object Vsjis_coding_system; +Lisp_Object Vbig5_coding_system; + +/* ISO2022 section */ + +#define CODING_ISO_INITIAL(coding, reg) \ + (XINT (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \ + coding_attr_iso_initial), \ + reg))) + + +#define CODING_ISO_REQUEST(coding, charset_id) \ + ((charset_id <= (coding)->max_charset_id \ + ? (coding)->safe_charsets[charset_id] \ + : -1)) + + +#define CODING_ISO_FLAGS(coding) \ + ((coding)->spec.iso_2022.flags) +#define CODING_ISO_DESIGNATION(coding, reg) \ + ((coding)->spec.iso_2022.current_designation[reg]) +#define CODING_ISO_INVOCATION(coding, plane) \ + ((coding)->spec.iso_2022.current_invocation[plane]) +#define CODING_ISO_SINGLE_SHIFTING(coding) \ + ((coding)->spec.iso_2022.single_shifting) +#define CODING_ISO_BOL(coding) \ + ((coding)->spec.iso_2022.bol) +#define CODING_ISO_INVOKED_CHARSET(coding, plane) \ + CODING_ISO_DESIGNATION ((coding), CODING_ISO_INVOCATION ((coding), (plane))) + +/* Control characters of ISO2022. */ + /* code */ /* function */ +#define ISO_CODE_LF 0x0A /* line-feed */ +#define ISO_CODE_CR 0x0D /* carriage-return */ +#define ISO_CODE_SO 0x0E /* shift-out */ +#define ISO_CODE_SI 0x0F /* shift-in */ +#define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */ +#define ISO_CODE_ESC 0x1B /* escape */ +#define ISO_CODE_SS2 0x8E /* single-shift-2 */ +#define ISO_CODE_SS3 0x8F /* single-shift-3 */ +#define ISO_CODE_CSI 0x9B /* control-sequence-introducer */ + +/* All code (1-byte) of ISO2022 is classified into one of the + followings. */ +enum iso_code_class_type + { + ISO_control_0, /* Control codes in the range + 0x00..0x1F and 0x7F, except for the + following 5 codes. */ + ISO_shift_out, /* ISO_CODE_SO (0x0E) */ + ISO_shift_in, /* ISO_CODE_SI (0x0F) */ + ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */ + ISO_escape, /* ISO_CODE_SO (0x1B) */ + ISO_control_1, /* Control codes in the range + 0x80..0x9F, except for the + following 3 codes. */ + ISO_single_shift_2, /* ISO_CODE_SS2 (0x8E) */ + ISO_single_shift_3, /* ISO_CODE_SS3 (0x8F) */ + ISO_control_sequence_introducer, /* ISO_CODE_CSI (0x9B) */ + ISO_0x20_or_0x7F, /* Codes of the values 0x20 or 0x7F. */ + ISO_graphic_plane_0, /* Graphic codes in the range 0x21..0x7E. */ + ISO_0xA0_or_0xFF, /* Codes of the values 0xA0 or 0xFF. */ + ISO_graphic_plane_1 /* Graphic codes in the range 0xA1..0xFE. */ + }; + +/** The macros CODING_ISO_FLAG_XXX defines a flag bit of the + `iso-flags' attribute of an iso2022 coding system. */ -Lisp_Object Qchar_coding_system; +/* If set, produce long-form designation sequence (e.g. ESC $ ( A) + instead of the correct short-form sequence (e.g. ESC $ A). */ +#define CODING_ISO_FLAG_LONG_FORM 0x0001 -/* Return `safe-chars' property of CODING_SYSTEM (symbol). Don't check - its validity. */ +/* If set, reset graphic planes and registers at end-of-line to the + initial state. */ +#define CODING_ISO_FLAG_RESET_AT_EOL 0x0002 -Lisp_Object -coding_safe_chars (coding_system) - Lisp_Object coding_system; +/* If set, reset graphic planes and registers before any control + characters to the initial state. */ +#define CODING_ISO_FLAG_RESET_AT_CNTL 0x0004 + +/* If set, encode by 7-bit environment. */ +#define CODING_ISO_FLAG_SEVEN_BITS 0x0008 + +/* If set, use locking-shift function. */ +#define CODING_ISO_FLAG_LOCKING_SHIFT 0x0010 + +/* If set, use single-shift function. Overwrite + CODING_ISO_FLAG_LOCKING_SHIFT. */ +#define CODING_ISO_FLAG_SINGLE_SHIFT 0x0020 + +/* If set, use designation escape sequence. */ +#define CODING_ISO_FLAG_DESIGNATION 0x0040 + +/* If set, produce revision number sequence. */ +#define CODING_ISO_FLAG_REVISION 0x0080 + +/* If set, produce ISO6429's direction specifying sequence. */ +#define CODING_ISO_FLAG_DIRECTION 0x0100 + +/* If set, assume designation states are reset at beginning of line on + output. */ +#define CODING_ISO_FLAG_INIT_AT_BOL 0x0200 + +/* If set, designation sequence should be placed at beginning of line + on output. */ +#define CODING_ISO_FLAG_DESIGNATE_AT_BOL 0x0400 + +/* If set, do not encode unsafe charactes on output. */ +#define CODING_ISO_FLAG_SAFE 0x0800 + +/* If set, extra latin codes (128..159) are accepted as a valid code + on input. */ +#define CODING_ISO_FLAG_LATIN_EXTRA 0x1000 + +#define CODING_ISO_FLAG_COMPOSITION 0x2000 + +#define CODING_ISO_FLAG_EUC_TW_SHIFT 0x4000 + +#define CODING_ISO_FLAG_USE_ROMAN 0x8000 + +#define CODING_ISO_FLAG_USE_OLDJIS 0x10000 + +#define CODING_ISO_FLAG_FULL_SUPPORT 0x100000 + +/* A character to be produced on output if encoding of the original + character is prohibited by CODING_ISO_FLAG_SAFE. */ +#define CODING_INHIBIT_CHARACTER_SUBSTITUTION '?' + + +/* UTF-16 section */ +#define CODING_UTF_16_BOM(coding) \ + ((coding)->spec.utf_16.bom) + +#define CODING_UTF_16_ENDIAN(coding) \ + ((coding)->spec.utf_16.endian) + +#define CODING_UTF_16_SURROGATE(coding) \ + ((coding)->spec.utf_16.surrogate) + + +/* CCL section */ +#define CODING_CCL_DECODER(coding) \ + AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_decoder) +#define CODING_CCL_ENCODER(coding) \ + AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_encoder) +#define CODING_CCL_VALIDS(coding) \ + (SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids))) + +/* Index for each coding category in `coding_categories' */ + +enum coding_category + { + coding_category_iso_7, + coding_category_iso_7_tight, + coding_category_iso_8_1, + coding_category_iso_8_2, + coding_category_iso_7_else, + coding_category_iso_8_else, + coding_category_utf_8, + coding_category_utf_16_auto, + coding_category_utf_16_be, + coding_category_utf_16_le, + coding_category_utf_16_be_nosig, + coding_category_utf_16_le_nosig, + coding_category_charset, + coding_category_sjis, + coding_category_big5, + coding_category_ccl, + coding_category_emacs_mule, + /* All above are targets of code detection. */ + coding_category_raw_text, + coding_category_undecided, + coding_category_max + }; + +/* Definitions of flag bits used in detect_coding_XXXX. */ +#define CATEGORY_MASK_ISO_7 (1 << coding_category_iso_7) +#define CATEGORY_MASK_ISO_7_TIGHT (1 << coding_category_iso_7_tight) +#define CATEGORY_MASK_ISO_8_1 (1 << coding_category_iso_8_1) +#define CATEGORY_MASK_ISO_8_2 (1 << coding_category_iso_8_2) +#define CATEGORY_MASK_ISO_7_ELSE (1 << coding_category_iso_7_else) +#define CATEGORY_MASK_ISO_8_ELSE (1 << coding_category_iso_8_else) +#define CATEGORY_MASK_UTF_8 (1 << coding_category_utf_8) +#define CATEGORY_MASK_UTF_16_AUTO (1 << coding_category_utf_16_auto) +#define CATEGORY_MASK_UTF_16_BE (1 << coding_category_utf_16_be) +#define CATEGORY_MASK_UTF_16_LE (1 << coding_category_utf_16_le) +#define CATEGORY_MASK_UTF_16_BE_NOSIG (1 << coding_category_utf_16_be_nosig) +#define CATEGORY_MASK_UTF_16_LE_NOSIG (1 << coding_category_utf_16_le_nosig) +#define CATEGORY_MASK_CHARSET (1 << coding_category_charset) +#define CATEGORY_MASK_SJIS (1 << coding_category_sjis) +#define CATEGORY_MASK_BIG5 (1 << coding_category_big5) +#define CATEGORY_MASK_CCL (1 << coding_category_ccl) +#define CATEGORY_MASK_EMACS_MULE (1 << coding_category_emacs_mule) +#define CATEGORY_MASK_RAW_TEXT (1 << coding_category_raw_text) + +/* This value is returned if detect_coding_mask () find nothing other + than ASCII characters. */ +#define CATEGORY_MASK_ANY \ + (CATEGORY_MASK_ISO_7 \ + | CATEGORY_MASK_ISO_7_TIGHT \ + | CATEGORY_MASK_ISO_8_1 \ + | CATEGORY_MASK_ISO_8_2 \ + | CATEGORY_MASK_ISO_7_ELSE \ + | CATEGORY_MASK_ISO_8_ELSE \ + | CATEGORY_MASK_UTF_8 \ + | CATEGORY_MASK_UTF_16_BE \ + | CATEGORY_MASK_UTF_16_LE \ + | CATEGORY_MASK_UTF_16_BE_NOSIG \ + | CATEGORY_MASK_UTF_16_LE_NOSIG \ + | CATEGORY_MASK_CHARSET \ + | CATEGORY_MASK_SJIS \ + | CATEGORY_MASK_BIG5 \ + | CATEGORY_MASK_CCL \ + | CATEGORY_MASK_EMACS_MULE) + + +#define CATEGORY_MASK_ISO_7BIT \ + (CATEGORY_MASK_ISO_7 | CATEGORY_MASK_ISO_7_TIGHT) + +#define CATEGORY_MASK_ISO_8BIT \ + (CATEGORY_MASK_ISO_8_1 | CATEGORY_MASK_ISO_8_2) + +#define CATEGORY_MASK_ISO_ELSE \ + (CATEGORY_MASK_ISO_7_ELSE | CATEGORY_MASK_ISO_8_ELSE) + +#define CATEGORY_MASK_ISO_ESCAPE \ + (CATEGORY_MASK_ISO_7 \ + | CATEGORY_MASK_ISO_7_TIGHT \ + | CATEGORY_MASK_ISO_7_ELSE \ + | CATEGORY_MASK_ISO_8_ELSE) + +#define CATEGORY_MASK_ISO \ + ( CATEGORY_MASK_ISO_7BIT \ + | CATEGORY_MASK_ISO_8BIT \ + | CATEGORY_MASK_ISO_ELSE) + +#define CATEGORY_MASK_UTF_16 \ + (CATEGORY_MASK_UTF_16_BE \ + | CATEGORY_MASK_UTF_16_LE \ + | CATEGORY_MASK_UTF_16_BE_NOSIG \ + | CATEGORY_MASK_UTF_16_LE_NOSIG) + + +/* List of symbols `coding-category-xxx' ordered by priority. This + variable is exposed to Emacs Lisp. */ +static Lisp_Object Vcoding_category_list; + +/* Table of coding categories (Lisp symbols). This variable is for + internal use oly. */ +static Lisp_Object Vcoding_category_table; + +/* Table of coding-categories ordered by priority. */ +static enum coding_category coding_priorities[coding_category_max]; + +/* Nth element is a coding context for the coding system bound to the + Nth coding category. */ +static struct coding_system coding_categories[coding_category_max]; + +/*** Commonly used macros and functions ***/ + +#ifndef min +#define min(a, b) ((a) < (b) ? (a) : (b)) +#endif +#ifndef max +#define max(a, b) ((a) > (b) ? (a) : (b)) +#endif + +#define CODING_GET_INFO(coding, attrs, charset_list) \ + do { \ + (attrs) = CODING_ID_ATTRS ((coding)->id); \ + (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \ + } while (0) + + +/* Safely get one byte from the source text pointed by SRC which ends + at SRC_END, and set C to that byte. If there are not enough bytes + in the source, it jumps to `no_more_source'. If multibytep is + nonzero, and a multibyte character is found at SRC, set C to the + negative value of the character code. The caller should declare + and set these variables appropriately in advance: + src, src_end, multibytep */ + +#define ONE_MORE_BYTE(c) \ + do { \ + if (src == src_end) \ + { \ + if (src_base < src) \ + record_conversion_result \ + (coding, CODING_RESULT_INSUFFICIENT_SRC); \ + goto no_more_source; \ + } \ + c = *src++; \ + if (multibytep && (c & 0x80)) \ + { \ + if ((c & 0xFE) == 0xC0) \ + c = ((c & 1) << 6) | *src++; \ + else \ + { \ + src--; \ + c = - string_char (src, &src, NULL); \ + record_conversion_result \ + (coding, CODING_RESULT_INVALID_SRC); \ + } \ + } \ + consumed_chars++; \ + } while (0) + + +#define ONE_MORE_BYTE_NO_CHECK(c) \ + do { \ + c = *src++; \ + if (multibytep && (c & 0x80)) \ + { \ + if ((c & 0xFE) == 0xC0) \ + c = ((c & 1) << 6) | *src++; \ + else \ + { \ + src--; \ + c = - string_char (src, &src, NULL); \ + record_conversion_result \ + (coding, CODING_RESULT_INVALID_SRC); \ + } \ + } \ + consumed_chars++; \ + } while (0) + + +/* Store a byte C in the place pointed by DST and increment DST to the + next free point, and increment PRODUCED_CHARS. The caller should + assure that C is 0..127, and declare and set the variable `dst' + appropriately in advance. +*/ + + +#define EMIT_ONE_ASCII_BYTE(c) \ + do { \ + produced_chars++; \ + *dst++ = (c); \ + } while (0) + + +/* Like EMIT_ONE_ASCII_BYTE byt store two bytes; C1 and C2. */ + +#define EMIT_TWO_ASCII_BYTES(c1, c2) \ + do { \ + produced_chars += 2; \ + *dst++ = (c1), *dst++ = (c2); \ + } while (0) + + +/* Store a byte C in the place pointed by DST and increment DST to the + next free point, and increment PRODUCED_CHARS. If MULTIBYTEP is + nonzero, store in an appropriate multibyte from. The caller should + declare and set the variables `dst' and `multibytep' appropriately + in advance. */ + +#define EMIT_ONE_BYTE(c) \ + do { \ + produced_chars++; \ + if (multibytep) \ + { \ + int ch = (c); \ + if (ch >= 0x80) \ + ch = BYTE8_TO_CHAR (ch); \ + CHAR_STRING_ADVANCE (ch, dst); \ + } \ + else \ + *dst++ = (c); \ + } while (0) + + +/* Like EMIT_ONE_BYTE, but emit two bytes; C1 and C2. */ + +#define EMIT_TWO_BYTES(c1, c2) \ + do { \ + produced_chars += 2; \ + if (multibytep) \ + { \ + int ch; \ + \ + ch = (c1); \ + if (ch >= 0x80) \ + ch = BYTE8_TO_CHAR (ch); \ + CHAR_STRING_ADVANCE (ch, dst); \ + ch = (c2); \ + if (ch >= 0x80) \ + ch = BYTE8_TO_CHAR (ch); \ + CHAR_STRING_ADVANCE (ch, dst); \ + } \ + else \ + { \ + *dst++ = (c1); \ + *dst++ = (c2); \ + } \ + } while (0) + + +#define EMIT_THREE_BYTES(c1, c2, c3) \ + do { \ + EMIT_ONE_BYTE (c1); \ + EMIT_TWO_BYTES (c2, c3); \ + } while (0) + + +#define EMIT_FOUR_BYTES(c1, c2, c3, c4) \ + do { \ + EMIT_TWO_BYTES (c1, c2); \ + EMIT_TWO_BYTES (c3, c4); \ + } while (0) + + +/* Prototypes for static functions. */ +static void record_conversion_result P_ ((struct coding_system *coding, + enum coding_result_code result)); +static int detect_coding_utf_8 P_ ((struct coding_system *, + struct coding_detection_info *info)); +static void decode_coding_utf_8 P_ ((struct coding_system *)); +static int encode_coding_utf_8 P_ ((struct coding_system *)); + +static int detect_coding_utf_16 P_ ((struct coding_system *, + struct coding_detection_info *info)); +static void decode_coding_utf_16 P_ ((struct coding_system *)); +static int encode_coding_utf_16 P_ ((struct coding_system *)); + +static int detect_coding_iso_2022 P_ ((struct coding_system *, + struct coding_detection_info *info)); +static void decode_coding_iso_2022 P_ ((struct coding_system *)); +static int encode_coding_iso_2022 P_ ((struct coding_system *)); + +static int detect_coding_emacs_mule P_ ((struct coding_system *, + struct coding_detection_info *info)); +static void decode_coding_emacs_mule P_ ((struct coding_system *)); +static int encode_coding_emacs_mule P_ ((struct coding_system *)); + +static int detect_coding_sjis P_ ((struct coding_system *, + struct coding_detection_info *info)); +static void decode_coding_sjis P_ ((struct coding_system *)); +static int encode_coding_sjis P_ ((struct coding_system *)); + +static int detect_coding_big5 P_ ((struct coding_system *, + struct coding_detection_info *info)); +static void decode_coding_big5 P_ ((struct coding_system *)); +static int encode_coding_big5 P_ ((struct coding_system *)); + +static int detect_coding_ccl P_ ((struct coding_system *, + struct coding_detection_info *info)); +static void decode_coding_ccl P_ ((struct coding_system *)); +static int encode_coding_ccl P_ ((struct coding_system *)); + +static void decode_coding_raw_text P_ ((struct coding_system *)); +static int encode_coding_raw_text P_ ((struct coding_system *)); + +static void coding_set_source P_ ((struct coding_system *)); +static void coding_set_destination P_ ((struct coding_system *)); +static void coding_alloc_by_realloc P_ ((struct coding_system *, EMACS_INT)); +static void coding_alloc_by_making_gap P_ ((struct coding_system *, + EMACS_INT, EMACS_INT)); +static unsigned char *alloc_destination P_ ((struct coding_system *, + EMACS_INT, unsigned char *)); +static void setup_iso_safe_charsets P_ ((Lisp_Object)); +static unsigned char *encode_designation_at_bol P_ ((struct coding_system *, + int *, int *, + unsigned char *)); +static int detect_eol P_ ((const unsigned char *, + EMACS_INT, enum coding_category)); +static Lisp_Object adjust_coding_eol_type P_ ((struct coding_system *, int)); +static void decode_eol P_ ((struct coding_system *)); +static Lisp_Object get_translation_table P_ ((Lisp_Object, int, int *)); +static Lisp_Object get_translation P_ ((Lisp_Object, int *, int *, + int, int *, int *)); +static int produce_chars P_ ((struct coding_system *, Lisp_Object, int)); +static INLINE void produce_composition P_ ((struct coding_system *, int *, + EMACS_INT)); +static INLINE void produce_charset P_ ((struct coding_system *, int *, + EMACS_INT)); +static void produce_annotation P_ ((struct coding_system *, EMACS_INT)); +static int decode_coding P_ ((struct coding_system *)); +static INLINE int *handle_composition_annotation P_ ((EMACS_INT, EMACS_INT, + struct coding_system *, + int *, EMACS_INT *)); +static INLINE int *handle_charset_annotation P_ ((EMACS_INT, EMACS_INT, + struct coding_system *, + int *, EMACS_INT *)); +static void consume_chars P_ ((struct coding_system *, Lisp_Object, int)); +static int encode_coding P_ ((struct coding_system *)); +static Lisp_Object make_conversion_work_buffer P_ ((int)); +static Lisp_Object code_conversion_restore P_ ((Lisp_Object)); +static INLINE int char_encodable_p P_ ((int, Lisp_Object)); +static Lisp_Object make_subsidiaries P_ ((Lisp_Object)); + +static void +record_conversion_result (struct coding_system *coding, + enum coding_result_code result) +{ + coding->result = result; + switch (result) + { + case CODING_RESULT_INSUFFICIENT_SRC: + Vlast_code_conversion_error = Qinsufficient_source; + break; + case CODING_RESULT_INCONSISTENT_EOL: + Vlast_code_conversion_error = Qinconsistent_eol; + break; + case CODING_RESULT_INVALID_SRC: + Vlast_code_conversion_error = Qinvalid_source; + break; + case CODING_RESULT_INTERRUPT: + Vlast_code_conversion_error = Qinterrupted; + break; + case CODING_RESULT_INSUFFICIENT_MEM: + Vlast_code_conversion_error = Qinsufficient_memory; + break; + default: + Vlast_code_conversion_error = intern ("Unknown error"); + } +} + +#define CODING_DECODE_CHAR(coding, src, src_base, src_end, charset, code, c) \ + do { \ + charset_map_loaded = 0; \ + c = DECODE_CHAR (charset, code); \ + if (charset_map_loaded) \ + { \ + const unsigned char *orig = coding->source; \ + EMACS_INT offset; \ + \ + coding_set_source (coding); \ + offset = coding->source - orig; \ + src += offset; \ + src_base += offset; \ + src_end += offset; \ + } \ + } while (0) + + +#define ASSURE_DESTINATION(bytes) \ + do { \ + if (dst + (bytes) >= dst_end) \ + { \ + int more_bytes = charbuf_end - charbuf + (bytes); \ + \ + dst = alloc_destination (coding, more_bytes, dst); \ + dst_end = coding->destination + coding->dst_bytes; \ + } \ + } while (0) + + + +static void +coding_set_source (coding) + struct coding_system *coding; +{ + if (BUFFERP (coding->src_object)) + { + struct buffer *buf = XBUFFER (coding->src_object); + + if (coding->src_pos < 0) + coding->source = BUF_GAP_END_ADDR (buf) + coding->src_pos_byte; + else + coding->source = BUF_BYTE_ADDRESS (buf, coding->src_pos_byte); + } + else if (STRINGP (coding->src_object)) + { + coding->source = SDATA (coding->src_object) + coding->src_pos_byte; + } + else + /* Otherwise, the source is C string and is never relocated + automatically. Thus we don't have to update anything. */ + ; +} + +static void +coding_set_destination (coding) + struct coding_system *coding; +{ + if (BUFFERP (coding->dst_object)) + { + if (coding->src_pos < 0) + { + coding->destination = BEG_ADDR + coding->dst_pos_byte - 1; + coding->dst_bytes = (GAP_END_ADDR + - (coding->src_bytes - coding->consumed) + - coding->destination); + } + else + { + /* We are sure that coding->dst_pos_byte is before the gap + of the buffer. */ + coding->destination = (BUF_BEG_ADDR (XBUFFER (coding->dst_object)) + + coding->dst_pos_byte - 1); + coding->dst_bytes = (BUF_GAP_END_ADDR (XBUFFER (coding->dst_object)) + - coding->destination); + } + } + else + /* Otherwise, the destination is C string and is never relocated + automatically. Thus we don't have to update anything. */ + ; +} + + +static void +coding_alloc_by_realloc (coding, bytes) + struct coding_system *coding; + EMACS_INT bytes; +{ + coding->destination = (unsigned char *) xrealloc (coding->destination, + coding->dst_bytes + bytes); + coding->dst_bytes += bytes; +} + +static void +coding_alloc_by_making_gap (coding, offset, bytes) + struct coding_system *coding; + EMACS_INT offset, bytes; +{ + if (BUFFERP (coding->dst_object) + && EQ (coding->src_object, coding->dst_object)) + { + EMACS_INT add = offset + (coding->src_bytes - coding->consumed); + + GPT += offset, GPT_BYTE += offset; + GAP_SIZE -= add; ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add; + make_gap (bytes); + GAP_SIZE += add; ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add; + GPT -= offset, GPT_BYTE -= offset; + } + else + { + Lisp_Object this_buffer; + + this_buffer = Fcurrent_buffer (); + set_buffer_internal (XBUFFER (coding->dst_object)); + make_gap (bytes); + set_buffer_internal (XBUFFER (this_buffer)); + } +} + + +static unsigned char * +alloc_destination (coding, nbytes, dst) + struct coding_system *coding; + EMACS_INT nbytes; + unsigned char *dst; +{ + EMACS_INT offset = dst - coding->destination; + + if (BUFFERP (coding->dst_object)) + coding_alloc_by_making_gap (coding, offset, nbytes); + else + coding_alloc_by_realloc (coding, nbytes); + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding_set_destination (coding); + dst = coding->destination + offset; + return dst; +} + +/** Macros for annotations. */ + +/* Maximum length of annotation data (sum of annotations for + composition and charset). */ +#define MAX_ANNOTATION_LENGTH (4 + (MAX_COMPOSITION_COMPONENTS * 2) - 1 + 4) + +/* An annotation data is stored in the array coding->charbuf in this + format: + [ -LENGTH ANNOTATION_MASK NCHARS ... ] + LENGTH is the number of elements in the annotation. + ANNOTATION_MASK is one of CODING_ANNOTATE_XXX_MASK. + NCHARS is the number of characters in the text annotated. + + The format of the following elements depend on ANNOTATION_MASK. + + In the case of CODING_ANNOTATE_COMPOSITION_MASK, these elements + follows: + ... METHOD [ COMPOSITION-COMPONENTS ... ] + METHOD is one of enum composition_method. + Optionnal COMPOSITION-COMPONENTS are characters and composition + rules. + + In the case of CODING_ANNOTATE_CHARSET_MASK, one element CHARSET-ID + follows. */ + +#define ADD_ANNOTATION_DATA(buf, len, mask, nchars) \ + do { \ + *(buf)++ = -(len); \ + *(buf)++ = (mask); \ + *(buf)++ = (nchars); \ + coding->annotated = 1; \ + } while (0); + +#define ADD_COMPOSITION_DATA(buf, nchars, method) \ + do { \ + ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_COMPOSITION_MASK, nchars); \ + *buf++ = method; \ + } while (0) + + +#define ADD_CHARSET_DATA(buf, nchars, id) \ + do { \ + ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_CHARSET_MASK, nchars); \ + *buf++ = id; \ + } while (0) + + +/*** 2. Emacs' internal format (emacs-utf-8) ***/ + + + + +/*** 3. UTF-8 ***/ + +/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". + Check if a text is encoded in UTF-8. If it is, return 1, else + return 0. */ + +#define UTF_8_1_OCTET_P(c) ((c) < 0x80) +#define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80) +#define UTF_8_2_OCTET_LEADING_P(c) (((c) & 0xE0) == 0xC0) +#define UTF_8_3_OCTET_LEADING_P(c) (((c) & 0xF0) == 0xE0) +#define UTF_8_4_OCTET_LEADING_P(c) (((c) & 0xF8) == 0xF0) +#define UTF_8_5_OCTET_LEADING_P(c) (((c) & 0xFC) == 0xF8) + +static int +detect_coding_utf_8 (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; +{ + const unsigned char *src = coding->source, *src_base; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int consumed_chars = 0; + int found = 0; + + detect_info->checked |= CATEGORY_MASK_UTF_8; + /* A coding system of this category is always ASCII compatible. */ + src += coding->head_ascii; + + while (1) + { + int c, c1, c2, c3, c4; + + src_base = src; + ONE_MORE_BYTE (c); + if (c < 0 || UTF_8_1_OCTET_P (c)) + continue; + ONE_MORE_BYTE (c1); + if (c1 < 0 || ! UTF_8_EXTRA_OCTET_P (c1)) + break; + if (UTF_8_2_OCTET_LEADING_P (c)) + { + found = CATEGORY_MASK_UTF_8; + continue; + } + ONE_MORE_BYTE (c2); + if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2)) + break; + if (UTF_8_3_OCTET_LEADING_P (c)) + { + found = CATEGORY_MASK_UTF_8; + continue; + } + ONE_MORE_BYTE (c3); + if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3)) + break; + if (UTF_8_4_OCTET_LEADING_P (c)) + { + found = CATEGORY_MASK_UTF_8; + continue; + } + ONE_MORE_BYTE (c4); + if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4)) + break; + if (UTF_8_5_OCTET_LEADING_P (c)) + { + found = CATEGORY_MASK_UTF_8; + continue; + } + break; + } + detect_info->rejected |= CATEGORY_MASK_UTF_8; + return 0; + + no_more_source: + if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK) + { + detect_info->rejected |= CATEGORY_MASK_UTF_8; + return 0; + } + detect_info->found |= found; + return 1; +} + + +static void +decode_coding_utf_8 (coding) + struct coding_system *coding; +{ + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; + const unsigned char *src_base; + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end = coding->charbuf + coding->charbuf_size; + int consumed_chars = 0, consumed_chars_base; + int multibytep = coding->src_multibyte; + Lisp_Object attr, charset_list; + + CODING_GET_INFO (coding, attr, charset_list); + + while (1) + { + int c, c1, c2, c3, c4, c5; + + src_base = src; + consumed_chars_base = consumed_chars; + + if (charbuf >= charbuf_end) + break; + + ONE_MORE_BYTE (c1); + if (c1 < 0) + { + c = - c1; + } + else if (UTF_8_1_OCTET_P(c1)) + { + c = c1; + } + else + { + ONE_MORE_BYTE (c2); + if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2)) + goto invalid_code; + if (UTF_8_2_OCTET_LEADING_P (c1)) + { + c = ((c1 & 0x1F) << 6) | (c2 & 0x3F); + /* Reject overlong sequences here and below. Encoders + producing them are incorrect, they can be misleading, + and they mess up read/write invariance. */ + if (c < 128) + goto invalid_code; + } + else + { + ONE_MORE_BYTE (c3); + if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3)) + goto invalid_code; + if (UTF_8_3_OCTET_LEADING_P (c1)) + { + c = (((c1 & 0xF) << 12) + | ((c2 & 0x3F) << 6) | (c3 & 0x3F)); + if (c < 0x800 + || (c >= 0xd800 && c < 0xe000)) /* surrogates (invalid) */ + goto invalid_code; + } + else + { + ONE_MORE_BYTE (c4); + if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4)) + goto invalid_code; + if (UTF_8_4_OCTET_LEADING_P (c1)) + { + c = (((c1 & 0x7) << 18) | ((c2 & 0x3F) << 12) + | ((c3 & 0x3F) << 6) | (c4 & 0x3F)); + if (c < 0x10000) + goto invalid_code; + } + else + { + ONE_MORE_BYTE (c5); + if (c5 < 0 || ! UTF_8_EXTRA_OCTET_P (c5)) + goto invalid_code; + if (UTF_8_5_OCTET_LEADING_P (c1)) + { + c = (((c1 & 0x3) << 24) | ((c2 & 0x3F) << 18) + | ((c3 & 0x3F) << 12) | ((c4 & 0x3F) << 6) + | (c5 & 0x3F)); + if ((c > MAX_CHAR) || (c < 0x200000)) + goto invalid_code; + } + else + goto invalid_code; + } + } + } + } + + *charbuf++ = c; + continue; + + invalid_code: + src = src_base; + consumed_chars = consumed_chars_base; + ONE_MORE_BYTE (c); + *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c); + coding->errors++; + } + + no_more_source: + coding->consumed_char += consumed_chars_base; + coding->consumed = src_base - coding->source; + coding->charbuf_used = charbuf - coding->charbuf; +} + + +static int +encode_coding_utf_8 (coding) + struct coding_system *coding; { - Lisp_Object coding_spec, plist, safe_chars; + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int produced_chars = 0; + int c; + + if (multibytep) + { + int safe_room = MAX_MULTIBYTE_LENGTH * 2; + + while (charbuf < charbuf_end) + { + unsigned char str[MAX_MULTIBYTE_LENGTH], *p, *pend = str; + + ASSURE_DESTINATION (safe_room); + c = *charbuf++; + if (CHAR_BYTE8_P (c)) + { + c = CHAR_TO_BYTE8 (c); + EMIT_ONE_BYTE (c); + } + else + { + CHAR_STRING_ADVANCE (c, pend); + for (p = str; p < pend; p++) + EMIT_ONE_BYTE (*p); + } + } + } + else + { + int safe_room = MAX_MULTIBYTE_LENGTH; + + while (charbuf < charbuf_end) + { + ASSURE_DESTINATION (safe_room); + c = *charbuf++; + if (CHAR_BYTE8_P (c)) + *dst++ = CHAR_TO_BYTE8 (c); + else + dst += CHAR_STRING (c, dst); + produced_chars++; + } + } + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; + return 0; +} + + +/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". + Check if a text is encoded in one of UTF-16 based coding systems. + If it is, return 1, else return 0. */ + +#define UTF_16_HIGH_SURROGATE_P(val) \ + (((val) & 0xFC00) == 0xD800) + +#define UTF_16_LOW_SURROGATE_P(val) \ + (((val) & 0xFC00) == 0xDC00) + +#define UTF_16_INVALID_P(val) \ + (((val) == 0xFFFE) \ + || ((val) == 0xFFFF) \ + || UTF_16_LOW_SURROGATE_P (val)) + + +static int +detect_coding_utf_16 (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; +{ + const unsigned char *src = coding->source, *src_base = src; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int consumed_chars = 0; + int c1, c2; + + detect_info->checked |= CATEGORY_MASK_UTF_16; + if (coding->mode & CODING_MODE_LAST_BLOCK + && (coding->src_chars & 1)) + { + detect_info->rejected |= CATEGORY_MASK_UTF_16; + return 0; + } + + ONE_MORE_BYTE (c1); + ONE_MORE_BYTE (c2); + if ((c1 == 0xFF) && (c2 == 0xFE)) + { + detect_info->found |= (CATEGORY_MASK_UTF_16_LE + | CATEGORY_MASK_UTF_16_AUTO); + detect_info->rejected |= (CATEGORY_MASK_UTF_16_BE + | CATEGORY_MASK_UTF_16_BE_NOSIG + | CATEGORY_MASK_UTF_16_LE_NOSIG); + } + else if ((c1 == 0xFE) && (c2 == 0xFF)) + { + detect_info->found |= (CATEGORY_MASK_UTF_16_BE + | CATEGORY_MASK_UTF_16_AUTO); + detect_info->rejected |= (CATEGORY_MASK_UTF_16_LE + | CATEGORY_MASK_UTF_16_BE_NOSIG + | CATEGORY_MASK_UTF_16_LE_NOSIG); + } + else if (c1 >= 0 && c2 >= 0) + { + detect_info->rejected + |= (CATEGORY_MASK_UTF_16_BE | CATEGORY_MASK_UTF_16_LE); + } + no_more_source: + return 1; +} + +static void +decode_coding_utf_16 (coding) + struct coding_system *coding; +{ + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; + const unsigned char *src_base; + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end = coding->charbuf + coding->charbuf_size; + int consumed_chars = 0, consumed_chars_base; + int multibytep = coding->src_multibyte; + enum utf_16_bom_type bom = CODING_UTF_16_BOM (coding); + enum utf_16_endian_type endian = CODING_UTF_16_ENDIAN (coding); + int surrogate = CODING_UTF_16_SURROGATE (coding); + Lisp_Object attr, charset_list; + + CODING_GET_INFO (coding, attr, charset_list); + + if (bom == utf_16_with_bom) + { + int c, c1, c2; + + src_base = src; + ONE_MORE_BYTE (c1); + ONE_MORE_BYTE (c2); + c = (c1 << 8) | c2; + + if (endian == utf_16_big_endian + ? c != 0xFEFF : c != 0xFFFE) + { + /* The first two bytes are not BOM. Treat them as bytes + for a normal character. */ + src = src_base; + coding->errors++; + } + CODING_UTF_16_BOM (coding) = utf_16_without_bom; + } + else if (bom == utf_16_detect_bom) + { + /* We have already tried to detect BOM and failed in + detect_coding. */ + CODING_UTF_16_BOM (coding) = utf_16_without_bom; + } + + while (1) + { + int c, c1, c2; + + src_base = src; + consumed_chars_base = consumed_chars; + + if (charbuf + 2 >= charbuf_end) + break; + + ONE_MORE_BYTE (c1); + if (c1 < 0) + { + *charbuf++ = -c1; + continue; + } + ONE_MORE_BYTE (c2); + if (c2 < 0) + { + *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1); + *charbuf++ = -c2; + continue; + } + c = (endian == utf_16_big_endian + ? ((c1 << 8) | c2) : ((c2 << 8) | c1)); + if (surrogate) + { + if (! UTF_16_LOW_SURROGATE_P (c)) + { + if (endian == utf_16_big_endian) + c1 = surrogate >> 8, c2 = surrogate & 0xFF; + else + c1 = surrogate & 0xFF, c2 = surrogate >> 8; + *charbuf++ = c1; + *charbuf++ = c2; + coding->errors++; + if (UTF_16_HIGH_SURROGATE_P (c)) + CODING_UTF_16_SURROGATE (coding) = surrogate = c; + else + *charbuf++ = c; + } + else + { + c = ((surrogate - 0xD800) << 10) | (c - 0xDC00); + CODING_UTF_16_SURROGATE (coding) = surrogate = 0; + *charbuf++ = 0x10000 + c; + } + } + else + { + if (UTF_16_HIGH_SURROGATE_P (c)) + CODING_UTF_16_SURROGATE (coding) = surrogate = c; + else + *charbuf++ = c; + } + } - coding_spec = Fget (coding_system, Qcoding_system); - plist = XVECTOR (coding_spec)->contents[3]; - safe_chars = Fplist_get (XVECTOR (coding_spec)->contents[3], Qsafe_chars); - return (CHAR_TABLE_P (safe_chars) ? safe_chars : Qt); + no_more_source: + coding->consumed_char += consumed_chars_base; + coding->consumed = src_base - coding->source; + coding->charbuf_used = charbuf - coding->charbuf; } -#define CODING_SAFE_CHAR_P(safe_chars, c) \ - (EQ (safe_chars, Qt) || !NILP (CHAR_TABLE_REF (safe_chars, c))) +static int +encode_coding_utf_16 (coding) + struct coding_system *coding; +{ + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int safe_room = 8; + enum utf_16_bom_type bom = CODING_UTF_16_BOM (coding); + int big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian; + int produced_chars = 0; + Lisp_Object attrs, charset_list; + int c; + + CODING_GET_INFO (coding, attrs, charset_list); + + if (bom != utf_16_without_bom) + { + ASSURE_DESTINATION (safe_room); + if (big_endian) + EMIT_TWO_BYTES (0xFE, 0xFF); + else + EMIT_TWO_BYTES (0xFF, 0xFE); + CODING_UTF_16_BOM (coding) = utf_16_without_bom; + } + + while (charbuf < charbuf_end) + { + ASSURE_DESTINATION (safe_room); + c = *charbuf++; + if (c >= MAX_UNICODE_CHAR) + c = coding->default_char; + + if (c < 0x10000) + { + if (big_endian) + EMIT_TWO_BYTES (c >> 8, c & 0xFF); + else + EMIT_TWO_BYTES (c & 0xFF, c >> 8); + } + else + { + int c1, c2; + + c -= 0x10000; + c1 = (c >> 10) + 0xD800; + c2 = (c & 0x3FF) + 0xDC00; + if (big_endian) + EMIT_FOUR_BYTES (c1 >> 8, c1 & 0xFF, c2 >> 8, c2 & 0xFF); + else + EMIT_FOUR_BYTES (c1 & 0xFF, c1 >> 8, c2 & 0xFF, c2 >> 8); + } + } + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->produced = dst - coding->destination; + coding->produced_char += produced_chars; + return 0; +} -/*** 2. Emacs internal format (emacs-mule) handlers ***/ +/*** 6. Old Emacs' internal format (emacs-mule) ***/ /* Emacs' internal format for representation of multiple character sets is a kind of multi-byte encoding, i.e. characters are @@ -582,7 +1654,7 @@ coding_safe_chars (coding_system) In that case, a sequence of one-byte codes has a slightly different form. - Firstly, all characters in eight-bit-control are represented by + At first, all characters in eight-bit-control are represented by one-byte sequences which are their 8-bit code. Next, character composition data are represented by the byte @@ -591,12 +1663,12 @@ coding_safe_chars (coding_system) METHOD is 0xF0 plus one of composition method (enum composition_method), - BYTES is 0xA0 plus the byte length of these composition data, + BYTES is 0xA0 plus a byte length of this composition data, - CHARS is 0xA0 plus the number of characters composed by these + CHARS is 0x20 plus a number of characters composed by this data, - COMPONENTs are characters of multibyte form or composition + COMPONENTs are characters of multibye form or composition rules encoded by two-byte of ASCII codes. In addition, for backward compatibility, the following formats are @@ -613,596 +1685,601 @@ coding_safe_chars (coding_system) represents a composition rule. */ -enum emacs_code_class_type emacs_code_class[256]; - -/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". - Check if a text is encoded in Emacs' internal format. If it is, - return CODING_CATEGORY_MASK_EMACS_MULE, else return 0. */ +char emacs_mule_bytes[256]; -static int -detect_coding_emacs_mule (src, src_end, multibytep) - unsigned char *src, *src_end; - int multibytep; +int +emacs_mule_char (coding, src, nbytes, nchars, id) + struct coding_system *coding; + const unsigned char *src; + int *nbytes, *nchars, *id; { - unsigned char c; - int composing = 0; - /* Dummy for ONE_MORE_BYTE. */ - struct coding_system dummy_coding; - struct coding_system *coding = &dummy_coding; + const unsigned char *src_end = coding->source + coding->src_bytes; + const unsigned char *src_base = src; + int multibytep = coding->src_multibyte; + struct charset *charset; + unsigned code; + int c; + int consumed_chars = 0; - while (1) + ONE_MORE_BYTE (c); + if (c < 0) + { + c = -c; + charset = emacs_mule_charset[0]; + } + else { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, - CODING_CATEGORY_MASK_EMACS_MULE); - if (composing) + if (c >= 0xA0) { - if (c < 0xA0) - composing = 0; - else if (c == 0xA0) + /* Old style component character of a compostion. */ + if (c == 0xA0) { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, 0); - c &= 0x7F; + ONE_MORE_BYTE (c); + c -= 0x80; } else c -= 0x20; } - if (c < 0x20) - { - if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO) - return 0; - } - else if (c >= 0x80 && c < 0xA0) + switch (emacs_mule_bytes[c]) { - if (c == 0x80) - /* Old leading code for a composite character. */ - composing = 1; + case 2: + if (! (charset = emacs_mule_charset[c])) + goto invalid_code; + ONE_MORE_BYTE (c); + if (c < 0xA0) + goto invalid_code; + code = c & 0x7F; + break; + + case 3: + if (c == EMACS_MULE_LEADING_CODE_PRIVATE_11 + || c == EMACS_MULE_LEADING_CODE_PRIVATE_12) + { + ONE_MORE_BYTE (c); + if (c < 0xA0 || ! (charset = emacs_mule_charset[c])) + goto invalid_code; + ONE_MORE_BYTE (c); + if (c < 0xA0) + goto invalid_code; + code = c & 0x7F; + } else { - unsigned char *src_base = src - 1; - int bytes; - - if (!UNIBYTE_STR_AS_MULTIBYTE_P (src_base, src_end - src_base, - bytes)) - return 0; - src = src_base + bytes; + if (! (charset = emacs_mule_charset[c])) + goto invalid_code; + ONE_MORE_BYTE (c); + if (c < 0xA0) + goto invalid_code; + code = (c & 0x7F) << 8; + ONE_MORE_BYTE (c); + if (c < 0xA0) + goto invalid_code; + code |= c & 0x7F; } + break; + + case 4: + ONE_MORE_BYTE (c); + if (c < 0 || ! (charset = emacs_mule_charset[c])) + goto invalid_code; + ONE_MORE_BYTE (c); + if (c < 0xA0) + goto invalid_code; + code = (c & 0x7F) << 8; + ONE_MORE_BYTE (c); + if (c < 0xA0) + goto invalid_code; + code |= c & 0x7F; + break; + + case 1: + code = c; + charset = CHARSET_FROM_ID (ASCII_BYTE_P (code) + ? charset_ascii : charset_eight_bit); + break; + + default: + abort (); } + c = DECODE_CHAR (charset, code); + if (c < 0) + goto invalid_code; } + *nbytes = src - src_base; + *nchars = consumed_chars; + if (id) + *id = charset->id; + return c; + + no_more_source: + return -2; + + invalid_code: + return -1; } -/* Record the starting position START and METHOD of one composition. */ +/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". + Check if a text is encoded in `emacs-mule'. If it is, return 1, + else return 0. */ -#define CODING_ADD_COMPOSITION_START(coding, start, method) \ - do { \ - struct composition_data *cmp_data = coding->cmp_data; \ - int *data = cmp_data->data + cmp_data->used; \ - coding->cmp_data_start = cmp_data->used; \ - data[0] = -1; \ - data[1] = cmp_data->char_offset + start; \ - data[3] = (int) method; \ - cmp_data->used += 4; \ - } while (0) +static int +detect_coding_emacs_mule (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; +{ + const unsigned char *src = coding->source, *src_base; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int consumed_chars = 0; + int c; + int found = 0; -/* Record the ending position END of the current composition. */ + detect_info->checked |= CATEGORY_MASK_EMACS_MULE; + /* A coding system of this category is always ASCII compatible. */ + src += coding->head_ascii; -#define CODING_ADD_COMPOSITION_END(coding, end) \ - do { \ - struct composition_data *cmp_data = coding->cmp_data; \ - int *data = cmp_data->data + coding->cmp_data_start; \ - data[0] = cmp_data->used - coding->cmp_data_start; \ - data[2] = cmp_data->char_offset + end; \ - } while (0) + while (1) + { + src_base = src; + ONE_MORE_BYTE (c); + if (c < 0) + continue; + if (c == 0x80) + { + /* Perhaps the start of composite character. We simple skip + it because analyzing it is too heavy for detecting. But, + at least, we check that the composite character + constitues of more than 4 bytes. */ + const unsigned char *src_base; -/* Record one COMPONENT (alternate character or composition rule). */ + repeat: + src_base = src; + do + { + ONE_MORE_BYTE (c); + } + while (c >= 0xA0); -#define CODING_ADD_COMPOSITION_COMPONENT(coding, component) \ - do { \ - coding->cmp_data->data[coding->cmp_data->used++] = component; \ - if (coding->cmp_data->used - coding->cmp_data_start \ - == COMPOSITION_DATA_MAX_BUNCH_LENGTH) \ - { \ - CODING_ADD_COMPOSITION_END (coding, coding->produced_char); \ - coding->composing = COMPOSITION_NO; \ - } \ - } while (0) + if (src - src_base <= 4) + break; + found = CATEGORY_MASK_EMACS_MULE; + if (c == 0x80) + goto repeat; + } + if (c < 0x80) + { + if (c < 0x20 + && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)) + break; + } + else + { + int more_bytes = emacs_mule_bytes[*src_base] - 1; -/* Get one byte from a data pointed by SRC and increment SRC. If SRC - is not less than SRC_END, return -1 without incrementing Src. */ + while (more_bytes > 0) + { + ONE_MORE_BYTE (c); + if (c < 0xA0) + { + src--; /* Unread the last byte. */ + break; + } + more_bytes--; + } + if (more_bytes != 0) + break; + found = CATEGORY_MASK_EMACS_MULE; + } + } + detect_info->rejected |= CATEGORY_MASK_EMACS_MULE; + return 0; -#define SAFE_ONE_MORE_BYTE() (src >= src_end ? -1 : *src++) + no_more_source: + if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK) + { + detect_info->rejected |= CATEGORY_MASK_EMACS_MULE; + return 0; + } + detect_info->found |= found; + return 1; +} -/* Decode a character represented as a component of composition - sequence of Emacs 20 style at SRC. Set C to that character, store - its multibyte form sequence at P, and set P to the end of that - sequence. If no valid character is found, set C to -1. */ +/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */ -#define DECODE_EMACS_MULE_COMPOSITION_CHAR(c, p) \ - do { \ - int bytes; \ - \ - c = SAFE_ONE_MORE_BYTE (); \ - if (c < 0) \ - break; \ - if (CHAR_HEAD_P (c)) \ - c = -1; \ - else if (c == 0xA0) \ - { \ - c = SAFE_ONE_MORE_BYTE (); \ - if (c < 0xA0) \ - c = -1; \ - else \ - { \ - c -= 0x80; \ - *p++ = c; \ - } \ - } \ - else if (BASE_LEADING_CODE_P (c - 0x20)) \ - { \ - unsigned char *p0 = p; \ +/* Decode a character represented as a component of composition + sequence of Emacs 20/21 style at SRC. Set C to that character and + update SRC to the head of next character (or an encoded composition + rule). If SRC doesn't points a composition component, set C to -1. + If SRC points an invalid byte sequence, global exit by a return + value 0. */ + +#define DECODE_EMACS_MULE_COMPOSITION_CHAR(buf) \ + if (1) \ + { \ + int c; \ + int nbytes, nchars; \ \ - c -= 0x20; \ - *p++ = c; \ - bytes = BYTES_BY_CHAR_HEAD (c); \ - while (--bytes) \ - { \ - c = SAFE_ONE_MORE_BYTE (); \ - if (c < 0) \ - break; \ - *p++ = c; \ - } \ - if (UNIBYTE_STR_AS_MULTIBYTE_P (p0, p - p0, bytes) \ - || (coding->flags /* We are recovering a file. */ \ - && p0[0] == LEADING_CODE_8_BIT_CONTROL \ - && ! CHAR_HEAD_P (p0[1]))) \ - c = STRING_CHAR (p0, bytes); \ - else \ - c = -1; \ - } \ - else \ - c = -1; \ - } while (0) + if (src == src_end) \ + break; \ + c = emacs_mule_char (coding, src, &nbytes, &nchars, NULL);\ + if (c < 0) \ + { \ + if (c == -2) \ + break; \ + goto invalid_code; \ + } \ + *buf++ = c; \ + src += nbytes; \ + consumed_chars += nchars; \ + } \ + else /* Decode a composition rule represented as a component of composition - sequence of Emacs 20 style at SRC. Set C to the rule. If not - valid rule is found, set C to -1. */ + sequence of Emacs 20 style at SRC. Store the decoded rule in *BUF, + and increment BUF. If SRC points an invalid byte sequence, set C + to -1. */ -#define DECODE_EMACS_MULE_COMPOSITION_RULE(c) \ +#define DECODE_EMACS_MULE_COMPOSITION_RULE_20(buf) \ do { \ - c = SAFE_ONE_MORE_BYTE (); \ + int c, gref, nref; \ + \ + if (src >= src_end) \ + goto invalid_code; \ + ONE_MORE_BYTE_NO_CHECK (c); \ c -= 0xA0; \ if (c < 0 || c >= 81) \ - c = -1; \ - else \ - { \ - gref = c / 9, nref = c % 9; \ - c = COMPOSITION_ENCODE_RULE (gref, nref); \ - } \ + goto invalid_code; \ + \ + gref = c / 9, nref = c % 9; \ + *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \ } while (0) -/* Decode composition sequence encoded by `emacs-mule' at the source - pointed by SRC. SRC_END is the end of source. Store information - of the composition in CODING->cmp_data. - - For backward compatibility, decode also a composition sequence of - Emacs 20 style. In that case, the composition sequence contains - characters that should be extracted into a buffer or string. Store - those characters at *DESTINATION in multibyte form. - - If we encounter an invalid byte sequence, return 0. - If we encounter an insufficient source or destination, or - insufficient space in CODING->cmp_data, return 1. - Otherwise, return consumed bytes in the source. +/* Decode a composition rule represented as a component of composition + sequence of Emacs 21 style at SRC. Store the decoded rule in *BUF, + and increment BUF. If SRC points an invalid byte sequence, set C + to -1. */ -*/ -static INLINE int -decode_composition_emacs_mule (coding, src, src_end, - destination, dst_end, dst_bytes) - struct coding_system *coding; - const unsigned char *src, *src_end; - unsigned char **destination, *dst_end; - int dst_bytes; -{ - unsigned char *dst = *destination; - int method, data_len, nchars; - const unsigned char *src_base = src++; - /* Store components of composition. */ - int component[COMPOSITION_DATA_MAX_BUNCH_LENGTH]; - int ncomponent; - /* Store multibyte form of characters to be composed. This is for - Emacs 20 style composition sequence. */ - unsigned char buf[MAX_COMPOSITION_COMPONENTS * MAX_MULTIBYTE_LENGTH]; - unsigned char *bufp = buf; - int c, i, gref, nref; +#define DECODE_EMACS_MULE_COMPOSITION_RULE_21(buf) \ + do { \ + int gref, nref; \ + \ + if (src + 1>= src_end) \ + goto invalid_code; \ + ONE_MORE_BYTE_NO_CHECK (gref); \ + gref -= 0x20; \ + ONE_MORE_BYTE_NO_CHECK (nref); \ + nref -= 0x20; \ + if (gref < 0 || gref >= 81 \ + || nref < 0 || nref >= 81) \ + goto invalid_code; \ + *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \ + } while (0) - if (coding->cmp_data->used + COMPOSITION_DATA_MAX_BUNCH_LENGTH - >= COMPOSITION_DATA_SIZE) - { - coding->result = CODING_FINISH_INSUFFICIENT_CMP; - return -1; - } - ONE_MORE_BYTE (c); - if (c - 0xF0 >= COMPOSITION_RELATIVE - && c - 0xF0 <= COMPOSITION_WITH_RULE_ALTCHARS) - { - int with_rule; +#define DECODE_EMACS_MULE_21_COMPOSITION(c) \ + do { \ + /* Emacs 21 style format. The first three bytes at SRC are \ + (METHOD - 0xF2), (BYTES - 0xA0), (CHARS - 0xA0), where BYTES is \ + the byte length of this composition information, CHARS is the \ + number of characters composed by this composition. */ \ + enum composition_method method = c - 0xF2; \ + int *charbuf_base = charbuf; \ + int consumed_chars_limit; \ + int nbytes, nchars; \ + \ + ONE_MORE_BYTE (c); \ + if (c < 0) \ + goto invalid_code; \ + nbytes = c - 0xA0; \ + if (nbytes < 3) \ + goto invalid_code; \ + ONE_MORE_BYTE (c); \ + if (c < 0) \ + goto invalid_code; \ + nchars = c - 0xA0; \ + ADD_COMPOSITION_DATA (charbuf, nchars, method); \ + consumed_chars_limit = consumed_chars_base + nbytes; \ + if (method != COMPOSITION_RELATIVE) \ + { \ + int i = 0; \ + while (consumed_chars < consumed_chars_limit) \ + { \ + if (i % 2 && method != COMPOSITION_WITH_ALTCHARS) \ + DECODE_EMACS_MULE_COMPOSITION_RULE_21 (charbuf); \ + else \ + DECODE_EMACS_MULE_COMPOSITION_CHAR (charbuf); \ + i++; \ + } \ + if (consumed_chars < consumed_chars_limit) \ + goto invalid_code; \ + charbuf_base[0] -= i; \ + } \ + } while (0) - method = c - 0xF0; - with_rule = (method == COMPOSITION_WITH_RULE - || method == COMPOSITION_WITH_RULE_ALTCHARS); - ONE_MORE_BYTE (c); - data_len = c - 0xA0; - if (data_len < 4 - || src_base + data_len > src_end) - return 0; - ONE_MORE_BYTE (c); - nchars = c - 0xA0; - if (c < 1) - return 0; - for (ncomponent = 0; src < src_base + data_len; ncomponent++) - { - /* If it is longer than this, it can't be valid. */ - if (ncomponent >= COMPOSITION_DATA_MAX_BUNCH_LENGTH) - return 0; - if (ncomponent % 2 && with_rule) - { - ONE_MORE_BYTE (gref); - gref -= 32; - ONE_MORE_BYTE (nref); - nref -= 32; - c = COMPOSITION_ENCODE_RULE (gref, nref); - } - else - { - int bytes; - if (UNIBYTE_STR_AS_MULTIBYTE_P (src, src_end - src, bytes) - || (coding->flags /* We are recovering a file. */ - && src[0] == LEADING_CODE_8_BIT_CONTROL - && ! CHAR_HEAD_P (src[1]))) - c = STRING_CHAR (src, bytes); - else - c = *src, bytes = 1; - src += bytes; - } - component[ncomponent] = c; - } - } - else if (c >= 0x80) - { - /* This may be an old Emacs 20 style format. See the comment at - the section 2 of this file. */ - while (src < src_end && !CHAR_HEAD_P (*src)) src++; - if (src == src_end - && !(coding->mode & CODING_MODE_LAST_BLOCK)) - goto label_end_of_loop; +#define DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION(c) \ + do { \ + /* Emacs 20 style format for relative composition. */ \ + /* Store multibyte form of characters to be composed. */ \ + enum composition_method method = COMPOSITION_RELATIVE; \ + int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \ + int *buf = components; \ + int i, j; \ + \ + src = src_base; \ + ONE_MORE_BYTE (c); /* skip 0x80 */ \ + for (i = 0; *src >= 0xA0 && i < MAX_COMPOSITION_COMPONENTS; i++) \ + DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \ + if (i < 2) \ + goto invalid_code; \ + ADD_COMPOSITION_DATA (charbuf, i, method); \ + for (j = 0; j < i; j++) \ + *charbuf++ = components[j]; \ + } while (0) - src_end = src; - src = src_base + 1; - if (c < 0xC0) - { - method = COMPOSITION_RELATIVE; - for (ncomponent = 0; ncomponent < MAX_COMPOSITION_COMPONENTS;) - { - DECODE_EMACS_MULE_COMPOSITION_CHAR (c, bufp); - if (c < 0) - break; - component[ncomponent++] = c; - } - if (ncomponent < 2) - return 0; - nchars = ncomponent; - } - else if (c == 0xFF) - { - method = COMPOSITION_WITH_RULE; - src++; - DECODE_EMACS_MULE_COMPOSITION_CHAR (c, bufp); - if (c < 0) - return 0; - component[0] = c; - for (ncomponent = 1; - ncomponent < MAX_COMPOSITION_COMPONENTS * 2 - 1;) - { - DECODE_EMACS_MULE_COMPOSITION_RULE (c); - if (c < 0) - break; - component[ncomponent++] = c; - DECODE_EMACS_MULE_COMPOSITION_CHAR (c, bufp); - if (c < 0) - break; - component[ncomponent++] = c; - } - if (ncomponent < 3) - return 0; - nchars = (ncomponent + 1) / 2; - } - else - return 0; - } - else - return 0; - if (buf == bufp || dst + (bufp - buf) <= (dst_bytes ? dst_end : src)) - { - CODING_ADD_COMPOSITION_START (coding, coding->produced_char, method); - for (i = 0; i < ncomponent; i++) - CODING_ADD_COMPOSITION_COMPONENT (coding, component[i]); - CODING_ADD_COMPOSITION_END (coding, coding->produced_char + nchars); - if (buf < bufp) - { - unsigned char *p = buf; - EMIT_BYTES (p, bufp); - *destination += bufp - buf; - coding->produced_char += nchars; - } - return (src - src_base); - } - label_end_of_loop: - return -1; -} +#define DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION(c) \ + do { \ + /* Emacs 20 style format for rule-base composition. */ \ + /* Store multibyte form of characters to be composed. */ \ + enum composition_method method = COMPOSITION_WITH_RULE; \ + int *charbuf_base = charbuf; \ + int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \ + int *buf = components; \ + int i, j; \ + \ + DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \ + for (i = 1; i < MAX_COMPOSITION_COMPONENTS; i++) \ + { \ + if (*src < 0xA0) \ + break; \ + DECODE_EMACS_MULE_COMPOSITION_RULE_20 (buf); \ + DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \ + } \ + if (i <= 1 || (buf - components) % 2 == 0) \ + goto invalid_code; \ + if (charbuf + i + (i / 2) + 1 >= charbuf_end) \ + goto no_more_source; \ + ADD_COMPOSITION_DATA (charbuf, i, method); \ + i = i * 2 - 1; \ + for (j = 0; j < i; j++) \ + *charbuf++ = components[j]; \ + charbuf_base[0] -= i; \ + for (j = 0; j < i; j += 2) \ + *charbuf++ = components[j]; \ + } while (0) -/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */ static void -decode_coding_emacs_mule (coding, source, destination, src_bytes, dst_bytes) +decode_coding_emacs_mule (coding) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; { - const unsigned char *src = source; - const unsigned char *src_end = source + src_bytes; - unsigned char *dst = destination; - unsigned char *dst_end = destination + dst_bytes; - /* SRC_BASE remembers the start position in source in each loop. - The loop will be exited when there's not enough source code, or - when there's not enough destination area to produce a - character. */ + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; const unsigned char *src_base; + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end + = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH; + int consumed_chars = 0, consumed_chars_base; + int multibytep = coding->src_multibyte; + Lisp_Object attrs, charset_list; + int char_offset = coding->produced_char; + int last_offset = char_offset; + int last_id = charset_ascii; + + CODING_GET_INFO (coding, attrs, charset_list); - coding->produced_char = 0; - while ((src_base = src) < src_end) + while (1) { - unsigned char tmp[MAX_MULTIBYTE_LENGTH]; - const unsigned char *p; - int bytes; + int c; - if (*src == '\r') - { - int c = *src++; + src_base = src; + consumed_chars_base = consumed_chars; - if (coding->eol_type == CODING_EOL_CR) - c = '\n'; - else if (coding->eol_type == CODING_EOL_CRLF) - { - ONE_MORE_BYTE (c); - if (c != '\n') - { - src--; - c = '\r'; - } - } - *dst++ = c; - coding->produced_char++; - continue; - } - else if (*src == '\n') + if (charbuf >= charbuf_end) + break; + + ONE_MORE_BYTE (c); + if (c < 0) { - if ((coding->eol_type == CODING_EOL_CR - || coding->eol_type == CODING_EOL_CRLF) - && coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL) - { - coding->result = CODING_FINISH_INCONSISTENT_EOL; - goto label_end_of_loop; - } - *dst++ = *src++; - coding->produced_char++; - continue; + *charbuf++ = -c; + char_offset++; } - else if (*src == 0x80 && coding->cmp_data) + else if (c < 0x80) { - /* Start of composition data. */ - int consumed = decode_composition_emacs_mule (coding, src, src_end, - &dst, dst_end, - dst_bytes); - if (consumed < 0) - goto label_end_of_loop; - else if (consumed > 0) - { - src += consumed; - continue; - } - bytes = CHAR_STRING (*src, tmp); - p = tmp; - src++; + *charbuf++ = c; + char_offset++; } - else if (UNIBYTE_STR_AS_MULTIBYTE_P (src, src_end - src, bytes) - || (coding->flags /* We are recovering a file. */ - && src[0] == LEADING_CODE_8_BIT_CONTROL - && ! CHAR_HEAD_P (src[1]))) + else if (c == 0x80) { - p = src; - src += bytes; + ONE_MORE_BYTE (c); + if (c < 0) + goto invalid_code; + if (c - 0xF2 >= COMPOSITION_RELATIVE + && c - 0xF2 <= COMPOSITION_WITH_RULE_ALTCHARS) + DECODE_EMACS_MULE_21_COMPOSITION (c); + else if (c < 0xC0) + DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION (c); + else if (c == 0xFF) + DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION (c); + else + goto invalid_code; } - else + else if (c < 0xA0 && emacs_mule_bytes[c] > 1) { - int i, c; + int nbytes, nchars; + int id; - bytes = BYTES_BY_CHAR_HEAD (*src); - src++; - for (i = 1; i < bytes; i++) + src = src_base; + consumed_chars = consumed_chars_base; + c = emacs_mule_char (coding, src, &nbytes, &nchars, &id); + if (c < 0) { - ONE_MORE_BYTE (c); - if (CHAR_HEAD_P (c)) + if (c == -2) break; + goto invalid_code; } - if (i < bytes) - { - bytes = CHAR_STRING (*src_base, tmp); - p = tmp; - src = src_base + 1; - } - else + if (last_id != id) { - p = src_base; + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + last_id = id; + last_offset = char_offset; } + *charbuf++ = c; + src += nbytes; + consumed_chars += nchars; + char_offset++; } - if (dst + bytes >= (dst_bytes ? dst_end : src)) - { - coding->result = CODING_FINISH_INSUFFICIENT_DST; - break; - } - while (bytes--) *dst++ = *p++; - coding->produced_char++; + else + goto invalid_code; + continue; + + invalid_code: + src = src_base; + consumed_chars = consumed_chars_base; + ONE_MORE_BYTE (c); + *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c); + char_offset++; + coding->errors++; } - label_end_of_loop: - coding->consumed = coding->consumed_char = src_base - source; - coding->produced = dst - destination; -} + no_more_source: + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + coding->consumed_char += consumed_chars_base; + coding->consumed = src_base - coding->source; + coding->charbuf_used = charbuf - coding->charbuf; +} -/* Encode composition data stored at DATA into a special byte sequence - starting by 0x80. Update CODING->cmp_data_start and maybe - CODING->cmp_data for the next call. */ - -#define ENCODE_COMPOSITION_EMACS_MULE(coding, data) \ - do { \ - unsigned char buf[1024], *p0 = buf, *p; \ - int len = data[0]; \ - int i; \ - \ - buf[0] = 0x80; \ - buf[1] = 0xF0 + data[3]; /* METHOD */ \ - buf[3] = 0xA0 + (data[2] - data[1]); /* COMPOSED-CHARS */ \ - p = buf + 4; \ - if (data[3] == COMPOSITION_WITH_RULE \ - || data[3] == COMPOSITION_WITH_RULE_ALTCHARS) \ - { \ - p += CHAR_STRING (data[4], p); \ - for (i = 5; i < len; i += 2) \ - { \ - int gref, nref; \ - COMPOSITION_DECODE_RULE (data[i], gref, nref); \ - *p++ = 0x20 + gref; \ - *p++ = 0x20 + nref; \ - p += CHAR_STRING (data[i + 1], p); \ - } \ - } \ - else \ - { \ - for (i = 4; i < len; i++) \ - p += CHAR_STRING (data[i], p); \ - } \ - buf[2] = 0xA0 + (p - buf); /* COMPONENTS-BYTES */ \ - \ - if (dst + (p - buf) + 4 > (dst_bytes ? dst_end : src)) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_DST; \ - goto label_end_of_loop; \ - } \ - while (p0 < p) \ - *dst++ = *p0++; \ - coding->cmp_data_start += data[0]; \ - if (coding->cmp_data_start == coding->cmp_data->used \ - && coding->cmp_data->next) \ - { \ - coding->cmp_data = coding->cmp_data->next; \ - coding->cmp_data_start = 0; \ - } \ - } while (0) +#define EMACS_MULE_LEADING_CODES(id, codes) \ + do { \ + if (id < 0xA0) \ + codes[0] = id, codes[1] = 0; \ + else if (id < 0xE0) \ + codes[0] = 0x9A, codes[1] = id; \ + else if (id < 0xF0) \ + codes[0] = 0x9B, codes[1] = id; \ + else if (id < 0xF5) \ + codes[0] = 0x9C, codes[1] = id; \ + else \ + codes[0] = 0x9D, codes[1] = id; \ + } while (0); -static void encode_eol P_ ((struct coding_system *, const unsigned char *, - unsigned char *, int, int)); -static void -encode_coding_emacs_mule (coding, source, destination, src_bytes, dst_bytes) +static int +encode_coding_emacs_mule (coding) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; { - const unsigned char *src = source; - const unsigned char *src_end = source + src_bytes; - unsigned char *dst = destination; - unsigned char *dst_end = destination + dst_bytes; - const unsigned char *src_base; + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int safe_room = 8; + int produced_chars = 0; + Lisp_Object attrs, charset_list; int c; - int char_offset; - int *data; - - Lisp_Object translation_table; + int preferred_charset_id = -1; - translation_table = Qnil; - - /* Optimization for the case that there's no composition. */ - if (!coding->cmp_data || coding->cmp_data->used == 0) + CODING_GET_INFO (coding, attrs, charset_list); + if (! EQ (charset_list, Vemacs_mule_charset_list)) { - encode_eol (coding, source, destination, src_bytes, dst_bytes); - return; + CODING_ATTR_CHARSET_LIST (attrs) + = charset_list = Vemacs_mule_charset_list; } - char_offset = coding->cmp_data->char_offset; - data = coding->cmp_data->data + coding->cmp_data_start; - while (1) + while (charbuf < charbuf_end) { - src_base = src; + ASSURE_DESTINATION (safe_room); + c = *charbuf++; - /* If SRC starts a composition, encode the information about the - composition in advance. */ - if (coding->cmp_data_start < coding->cmp_data->used - && char_offset + coding->consumed_char == data[1]) + if (c < 0) { - ENCODE_COMPOSITION_EMACS_MULE (coding, data); - char_offset = coding->cmp_data->char_offset; - data = coding->cmp_data->data + coding->cmp_data_start; + /* Handle an annotation. */ + switch (*charbuf) + { + case CODING_ANNOTATE_COMPOSITION_MASK: + /* Not yet implemented. */ + break; + case CODING_ANNOTATE_CHARSET_MASK: + preferred_charset_id = charbuf[3]; + if (preferred_charset_id >= 0 + && NILP (Fmemq (make_number (preferred_charset_id), + charset_list))) + preferred_charset_id = -1; + break; + default: + abort (); + } + charbuf += -c - 1; + continue; } - ONE_MORE_CHAR (c); - if (c == '\n' && (coding->eol_type == CODING_EOL_CRLF - || coding->eol_type == CODING_EOL_CR)) + if (ASCII_CHAR_P (c)) + EMIT_ONE_ASCII_BYTE (c); + else if (CHAR_BYTE8_P (c)) { - if (coding->eol_type == CODING_EOL_CRLF) - EMIT_TWO_BYTES ('\r', c); - else - EMIT_ONE_BYTE ('\r'); + c = CHAR_TO_BYTE8 (c); + EMIT_ONE_BYTE (c); } - else if (SINGLE_BYTE_CHAR_P (c)) + else { - if (coding->flags && ! ASCII_BYTE_P (c)) - { - /* As we are auto saving, retain the multibyte form for - 8-bit chars. */ - unsigned char buf[MAX_MULTIBYTE_LENGTH]; - int bytes = CHAR_STRING (c, buf); + struct charset *charset; + unsigned code; + int dimension; + int emacs_mule_id; + unsigned char leading_codes[2]; - if (bytes == 1) - EMIT_ONE_BYTE (buf[0]); - else - EMIT_TWO_BYTES (buf[0], buf[1]); + if (preferred_charset_id >= 0) + { + charset = CHARSET_FROM_ID (preferred_charset_id); + if (! CHAR_CHARSET_P (c, charset)) + charset = char_charset (c, charset_list, NULL); } else - EMIT_ONE_BYTE (c); + charset = char_charset (c, charset_list, &code); + if (! charset) + { + c = coding->default_char; + if (ASCII_CHAR_P (c)) + { + EMIT_ONE_ASCII_BYTE (c); + continue; + } + charset = char_charset (c, charset_list, &code); + } + dimension = CHARSET_DIMENSION (charset); + emacs_mule_id = CHARSET_EMACS_MULE_ID (charset); + EMACS_MULE_LEADING_CODES (emacs_mule_id, leading_codes); + EMIT_ONE_BYTE (leading_codes[0]); + if (leading_codes[1]) + EMIT_ONE_BYTE (leading_codes[1]); + if (dimension == 1) + EMIT_ONE_BYTE (code | 0x80); + else + { + code |= 0x8080; + EMIT_ONE_BYTE (code >> 8); + EMIT_ONE_BYTE (code & 0xFF); + } } - else - EMIT_BYTES (src_base, src); - coding->consumed_char++; } - label_end_of_loop: - coding->consumed = src_base - source; - coding->produced = coding->produced_char = dst - destination; - return; + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; + return 0; } -/*** 3. ISO2022 handlers ***/ +/*** 7. ISO2022 handlers ***/ /* The following note describes the coding system ISO2022 briefly. Since the intention of this note is to help understand the @@ -1332,7 +2409,7 @@ encode_coding_emacs_mule (coding, source, destination, src_bytes, dst_bytes) 7-bit environment, non-locking-shift, and non-single-shift. Note (**): If <F> is '@', 'A', or 'B', the intermediate character - '(' can be omitted. We refer to this as "short-form" hereafter. + '(' must be omitted. We refer to this as "short-form" hereafter. Now you may notice that there are a lot of ways of encoding the same multilingual text in ISO2022. Actually, there exist many @@ -1362,10 +2439,10 @@ encode_coding_emacs_mule (coding, source, destination, src_bytes, dst_bytes) Since these are not standard escape sequences of any ISO standard, the use of them with these meanings is restricted to Emacs only. - (*) This form is used only in Emacs 20.5 and older versions, - but the newer versions can safely decode it. + (*) This form is used only in Emacs 20.7 and older versions, + but newer versions can safely decode it. (**) This form is used only in Emacs 21.1 and newer versions, - and the older versions can't decode it. + and older versions can't decode it. Here's a list of example usages of these composition escape sequences (categorized by `enum composition_method'). @@ -1381,422 +2458,438 @@ encode_coding_emacs_mule (coding, source, destination, src_bytes, dst_bytes) enum iso_code_class_type iso_code_class[256]; -#define CHARSET_OK(idx, charset, c) \ - (coding_system_table[idx] \ - && (charset == CHARSET_ASCII \ - || (safe_chars = coding_safe_chars (coding_system_table[idx]->symbol), \ - CODING_SAFE_CHAR_P (safe_chars, c))) \ - && (CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding_system_table[idx], \ - charset) \ - != CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION)) +#define SAFE_CHARSET_P(coding, id) \ + ((id) <= (coding)->max_charset_id \ + && (coding)->safe_charsets[id] >= 0) -#define SHIFT_OUT_OK(idx) \ - (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding_system_table[idx], 1) >= 0) -#define COMPOSITION_OK(idx) \ - (coding_system_table[idx]->composing != COMPOSITION_DISABLED) +#define SHIFT_OUT_OK(category) \ + (CODING_ISO_INITIAL (&coding_categories[category], 1) >= 0) + +static void +setup_iso_safe_charsets (attrs) + Lisp_Object attrs; +{ + Lisp_Object charset_list, safe_charsets; + Lisp_Object request; + Lisp_Object reg_usage; + Lisp_Object tail; + int reg94, reg96; + int flags = XINT (AREF (attrs, coding_attr_iso_flags)); + int max_charset_id; + + charset_list = CODING_ATTR_CHARSET_LIST (attrs); + if ((flags & CODING_ISO_FLAG_FULL_SUPPORT) + && ! EQ (charset_list, Viso_2022_charset_list)) + { + CODING_ATTR_CHARSET_LIST (attrs) + = charset_list = Viso_2022_charset_list; + ASET (attrs, coding_attr_safe_charsets, Qnil); + } + + if (STRINGP (AREF (attrs, coding_attr_safe_charsets))) + return; + + max_charset_id = 0; + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + { + int id = XINT (XCAR (tail)); + if (max_charset_id < id) + max_charset_id = id; + } + + safe_charsets = Fmake_string (make_number (max_charset_id + 1), + make_number (255)); + request = AREF (attrs, coding_attr_iso_request); + reg_usage = AREF (attrs, coding_attr_iso_usage); + reg94 = XINT (XCAR (reg_usage)); + reg96 = XINT (XCDR (reg_usage)); + + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object id; + Lisp_Object reg; + struct charset *charset; + + id = XCAR (tail); + charset = CHARSET_FROM_ID (XINT (id)); + reg = Fcdr (Fassq (id, request)); + if (! NILP (reg)) + SSET (safe_charsets, XINT (id), XINT (reg)); + else if (charset->iso_chars_96) + { + if (reg96 < 4) + SSET (safe_charsets, XINT (id), reg96); + } + else + { + if (reg94 < 4) + SSET (safe_charsets, XINT (id), reg94); + } + } + ASET (attrs, coding_attr_safe_charsets, safe_charsets); +} + /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". - Check if a text is encoded in ISO2022. If it is, return an - integer in which appropriate flag bits any of: - CODING_CATEGORY_MASK_ISO_7 - CODING_CATEGORY_MASK_ISO_7_TIGHT - CODING_CATEGORY_MASK_ISO_8_1 - CODING_CATEGORY_MASK_ISO_8_2 - CODING_CATEGORY_MASK_ISO_7_ELSE - CODING_CATEGORY_MASK_ISO_8_ELSE - are set. If a code which should never appear in ISO2022 is found, - returns 0. */ + Check if a text is encoded in one of ISO-2022 based codig systems. + If it is, return 1, else return 0. */ static int -detect_coding_iso2022 (src, src_end, multibytep) - unsigned char *src, *src_end; - int multibytep; +detect_coding_iso_2022 (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; { - int mask = CODING_CATEGORY_MASK_ISO; - int mask_found = 0; - int reg[4], shift_out = 0, single_shifting = 0; - int c, c1, charset; - /* Dummy for ONE_MORE_BYTE. */ - struct coding_system dummy_coding; - struct coding_system *coding = &dummy_coding; - Lisp_Object safe_chars; - - reg[0] = CHARSET_ASCII, reg[1] = reg[2] = reg[3] = -1; - while (mask) - { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, mask & mask_found); - retry: + const unsigned char *src = coding->source, *src_base = src; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int single_shifting = 0; + int id; + int c, c1; + int consumed_chars = 0; + int i; + int rejected = 0; + int found = 0; + + detect_info->checked |= CATEGORY_MASK_ISO; + + for (i = coding_category_iso_7; i <= coding_category_iso_8_else; i++) + { + struct coding_system *this = &(coding_categories[i]); + Lisp_Object attrs, val; + + attrs = CODING_ID_ATTRS (this->id); + if (CODING_ISO_FLAGS (this) & CODING_ISO_FLAG_FULL_SUPPORT + && ! EQ (CODING_ATTR_SAFE_CHARSETS (attrs), Viso_2022_charset_list)) + setup_iso_safe_charsets (attrs); + val = CODING_ATTR_SAFE_CHARSETS (attrs); + this->max_charset_id = SCHARS (val) - 1; + this->safe_charsets = (char *) SDATA (val); + } + + /* A coding system of this category is always ASCII compatible. */ + src += coding->head_ascii; + + while (rejected != CATEGORY_MASK_ISO) + { + src_base = src; + ONE_MORE_BYTE (c); switch (c) { case ISO_CODE_ESC: if (inhibit_iso_escape_detection) break; single_shifting = 0; - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, mask & mask_found); + ONE_MORE_BYTE (c); if (c >= '(' && c <= '/') { /* Designation sequence for a charset of dimension 1. */ - ONE_MORE_BYTE_CHECK_MULTIBYTE (c1, multibytep, mask & mask_found); + ONE_MORE_BYTE (c1); if (c1 < ' ' || c1 >= 0x80 - || (charset = iso_charset_table[0][c >= ','][c1]) < 0) + || (id = iso_charset_table[0][c >= ','][c1]) < 0) /* Invalid designation sequence. Just ignore. */ break; - reg[(c - '(') % 4] = charset; } else if (c == '$') { /* Designation sequence for a charset of dimension 2. */ - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, mask & mask_found); + ONE_MORE_BYTE (c); if (c >= '@' && c <= 'B') /* Designation for JISX0208.1978, GB2312, or JISX0208. */ - reg[0] = charset = iso_charset_table[1][0][c]; + id = iso_charset_table[1][0][c]; else if (c >= '(' && c <= '/') { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c1, multibytep, - mask & mask_found); + ONE_MORE_BYTE (c1); if (c1 < ' ' || c1 >= 0x80 - || (charset = iso_charset_table[1][c >= ','][c1]) < 0) + || (id = iso_charset_table[1][c >= ','][c1]) < 0) /* Invalid designation sequence. Just ignore. */ break; - reg[(c - '(') % 4] = charset; } else - /* Invalid designation sequence. Just ignore. */ + /* Invalid designation sequence. Just ignore it. */ break; } else if (c == 'N' || c == 'O') { /* ESC <Fe> for SS2 or SS3. */ - mask &= CODING_CATEGORY_MASK_ISO_7_ELSE; + single_shifting = 1; + rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT; break; } else if (c >= '0' && c <= '4') { /* ESC <Fp> for start/end composition. */ - if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_7)) - mask_found |= CODING_CATEGORY_MASK_ISO_7; - else - mask &= ~CODING_CATEGORY_MASK_ISO_7; - if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_7_TIGHT)) - mask_found |= CODING_CATEGORY_MASK_ISO_7_TIGHT; - else - mask &= ~CODING_CATEGORY_MASK_ISO_7_TIGHT; - if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_8_1)) - mask_found |= CODING_CATEGORY_MASK_ISO_8_1; - else - mask &= ~CODING_CATEGORY_MASK_ISO_8_1; - if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_8_2)) - mask_found |= CODING_CATEGORY_MASK_ISO_8_2; - else - mask &= ~CODING_CATEGORY_MASK_ISO_8_2; - if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_7_ELSE)) - mask_found |= CODING_CATEGORY_MASK_ISO_7_ELSE; - else - mask &= ~CODING_CATEGORY_MASK_ISO_7_ELSE; - if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_8_ELSE)) - mask_found |= CODING_CATEGORY_MASK_ISO_8_ELSE; - else - mask &= ~CODING_CATEGORY_MASK_ISO_8_ELSE; + found |= CATEGORY_MASK_ISO; break; } else - /* Invalid escape sequence. Just ignore. */ - break; + { + /* Invalid escape sequence. Just ignore it. */ + break; + } /* We found a valid designation sequence for CHARSET. */ - mask &= ~CODING_CATEGORY_MASK_ISO_8BIT; - c = MAKE_CHAR (charset, 0, 0); - if (CHARSET_OK (CODING_CATEGORY_IDX_ISO_7, charset, c)) - mask_found |= CODING_CATEGORY_MASK_ISO_7; + rejected |= CATEGORY_MASK_ISO_8BIT; + if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7], + id)) + found |= CATEGORY_MASK_ISO_7; else - mask &= ~CODING_CATEGORY_MASK_ISO_7; - if (CHARSET_OK (CODING_CATEGORY_IDX_ISO_7_TIGHT, charset, c)) - mask_found |= CODING_CATEGORY_MASK_ISO_7_TIGHT; + rejected |= CATEGORY_MASK_ISO_7; + if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_tight], + id)) + found |= CATEGORY_MASK_ISO_7_TIGHT; else - mask &= ~CODING_CATEGORY_MASK_ISO_7_TIGHT; - if (CHARSET_OK (CODING_CATEGORY_IDX_ISO_7_ELSE, charset, c)) - mask_found |= CODING_CATEGORY_MASK_ISO_7_ELSE; + rejected |= CATEGORY_MASK_ISO_7_TIGHT; + if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_else], + id)) + found |= CATEGORY_MASK_ISO_7_ELSE; else - mask &= ~CODING_CATEGORY_MASK_ISO_7_ELSE; - if (CHARSET_OK (CODING_CATEGORY_IDX_ISO_8_ELSE, charset, c)) - mask_found |= CODING_CATEGORY_MASK_ISO_8_ELSE; + rejected |= CATEGORY_MASK_ISO_7_ELSE; + if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_8_else], + id)) + found |= CATEGORY_MASK_ISO_8_ELSE; else - mask &= ~CODING_CATEGORY_MASK_ISO_8_ELSE; + rejected |= CATEGORY_MASK_ISO_8_ELSE; break; case ISO_CODE_SO: - if (inhibit_iso_escape_detection) - break; - single_shifting = 0; - if (shift_out == 0 - && (reg[1] >= 0 - || SHIFT_OUT_OK (CODING_CATEGORY_IDX_ISO_7_ELSE) - || SHIFT_OUT_OK (CODING_CATEGORY_IDX_ISO_8_ELSE))) - { - /* Locking shift out. */ - mask &= ~CODING_CATEGORY_MASK_ISO_7BIT; - mask_found |= CODING_CATEGORY_MASK_ISO_SHIFT; - } - break; - case ISO_CODE_SI: + /* Locking shift out/in. */ if (inhibit_iso_escape_detection) break; single_shifting = 0; - if (shift_out == 1) - { - /* Locking shift in. */ - mask &= ~CODING_CATEGORY_MASK_ISO_7BIT; - mask_found |= CODING_CATEGORY_MASK_ISO_SHIFT; - } + rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT; break; case ISO_CODE_CSI: + /* Control sequence introducer. */ single_shifting = 0; + rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE; + found |= CATEGORY_MASK_ISO_8_ELSE; + goto check_extra_latin; + case ISO_CODE_SS2: case ISO_CODE_SS3: - { - int newmask = CODING_CATEGORY_MASK_ISO_8_ELSE; - - if (inhibit_iso_escape_detection) - break; - if (c != ISO_CODE_CSI) - { - if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_1]->flags - & CODING_FLAG_ISO_SINGLE_SHIFT) - newmask |= CODING_CATEGORY_MASK_ISO_8_1; - if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_2]->flags - & CODING_FLAG_ISO_SINGLE_SHIFT) - newmask |= CODING_CATEGORY_MASK_ISO_8_2; - single_shifting = 1; - } - if (VECTORP (Vlatin_extra_code_table) - && !NILP (XVECTOR (Vlatin_extra_code_table)->contents[c])) - { - if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_1]->flags - & CODING_FLAG_ISO_LATIN_EXTRA) - newmask |= CODING_CATEGORY_MASK_ISO_8_1; - if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_2]->flags - & CODING_FLAG_ISO_LATIN_EXTRA) - newmask |= CODING_CATEGORY_MASK_ISO_8_2; - } - mask &= newmask; - mask_found |= newmask; - } - break; + /* Single shift. */ + if (inhibit_iso_escape_detection) + break; + single_shifting = 0; + rejected |= CATEGORY_MASK_ISO_7BIT; + if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1]) + & CODING_ISO_FLAG_SINGLE_SHIFT) + found |= CATEGORY_MASK_ISO_8_1, single_shifting = 1; + if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_2]) + & CODING_ISO_FLAG_SINGLE_SHIFT) + found |= CATEGORY_MASK_ISO_8_2, single_shifting = 1; + if (single_shifting) + break; + goto check_extra_latin; default: + if (c < 0) + continue; if (c < 0x80) { single_shifting = 0; break; } - else if (c < 0xA0) - { - single_shifting = 0; - if (VECTORP (Vlatin_extra_code_table) - && !NILP (XVECTOR (Vlatin_extra_code_table)->contents[c])) - { - int newmask = 0; - - if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_1]->flags - & CODING_FLAG_ISO_LATIN_EXTRA) - newmask |= CODING_CATEGORY_MASK_ISO_8_1; - if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_2]->flags - & CODING_FLAG_ISO_LATIN_EXTRA) - newmask |= CODING_CATEGORY_MASK_ISO_8_2; - mask &= newmask; - mask_found |= newmask; - } - else - return 0; - } - else + if (c >= 0xA0) { - mask &= ~(CODING_CATEGORY_MASK_ISO_7BIT - | CODING_CATEGORY_MASK_ISO_7_ELSE); - mask_found |= CODING_CATEGORY_MASK_ISO_8_1; + rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE; + found |= CATEGORY_MASK_ISO_8_1; /* Check the length of succeeding codes of the range - 0xA0..0FF. If the byte length is odd, we exclude - CODING_CATEGORY_MASK_ISO_8_2. We can check this only - when we are not single shifting. */ - if (!single_shifting - && mask & CODING_CATEGORY_MASK_ISO_8_2) + 0xA0..0FF. If the byte length is even, we include + CATEGORY_MASK_ISO_8_2 in `found'. We can check this + only when we are not single shifting. */ + if (! single_shifting + && ! (rejected & CATEGORY_MASK_ISO_8_2)) { int i = 1; - - c = -1; while (src < src_end) { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, - mask & mask_found); + ONE_MORE_BYTE (c); if (c < 0xA0) break; i++; } if (i & 1 && src < src_end) - mask &= ~CODING_CATEGORY_MASK_ISO_8_2; + rejected |= CATEGORY_MASK_ISO_8_2; else - mask_found |= CODING_CATEGORY_MASK_ISO_8_2; - if (c >= 0) - /* This means that we have read one extra byte. */ - goto retry; + found |= CATEGORY_MASK_ISO_8_2; } + break; } - break; + check_extra_latin: + single_shifting = 0; + if (! VECTORP (Vlatin_extra_code_table) + || NILP (XVECTOR (Vlatin_extra_code_table)->contents[c])) + { + rejected = CATEGORY_MASK_ISO; + break; + } + if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1]) + & CODING_ISO_FLAG_LATIN_EXTRA) + found |= CATEGORY_MASK_ISO_8_1; + else + rejected |= CATEGORY_MASK_ISO_8_1; + rejected |= CATEGORY_MASK_ISO_8_2; } } - return (mask & mask_found); -} + detect_info->rejected |= CATEGORY_MASK_ISO; + return 0; -/* Decode a character of which charset is CHARSET, the 1st position - code is C1, the 2nd position code is C2, and return the decoded - character code. If the variable `translation_table' is non-nil, - returned the translated code. */ + no_more_source: + detect_info->rejected |= rejected; + detect_info->found |= (found & ~rejected); + return 1; +} -#define DECODE_ISO_CHARACTER(charset, c1, c2) \ - (NILP (translation_table) \ - ? MAKE_CHAR (charset, c1, c2) \ - : translate_char (translation_table, -1, charset, c1, c2)) -/* Set designation state into CODING. */ -#define DECODE_DESIGNATION(reg, dimension, chars, final_char) \ - do { \ - int charset, c; \ - \ - if (final_char < '0' || final_char >= 128) \ - goto label_invalid_code; \ - charset = ISO_CHARSET_TABLE (make_number (dimension), \ - make_number (chars), \ - make_number (final_char)); \ - c = MAKE_CHAR (charset, 0, 0); \ - if (charset >= 0 \ - && (CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) == reg \ - || CODING_SAFE_CHAR_P (safe_chars, c))) \ - { \ - if (coding->spec.iso2022.last_invalid_designation_register == 0 \ - && reg == 0 \ - && charset == CHARSET_ASCII) \ - { \ - /* We should insert this designation sequence as is so \ - that it is surely written back to a file. */ \ - coding->spec.iso2022.last_invalid_designation_register = -1; \ - goto label_invalid_code; \ - } \ - coding->spec.iso2022.last_invalid_designation_register = -1; \ - if ((coding->mode & CODING_MODE_DIRECTION) \ - && CHARSET_REVERSE_CHARSET (charset) >= 0) \ - charset = CHARSET_REVERSE_CHARSET (charset); \ - CODING_SPEC_ISO_DESIGNATION (coding, reg) = charset; \ - } \ - else \ - { \ - coding->spec.iso2022.last_invalid_designation_register = reg; \ - goto label_invalid_code; \ - } \ +/* Set designation state into CODING. Set CHARS_96 to -1 if the + escape sequence should be kept. */ +#define DECODE_DESIGNATION(reg, dim, chars_96, final) \ + do { \ + int id, prev; \ + \ + if (final < '0' || final >= 128 \ + || ((id = ISO_CHARSET_TABLE (dim, chars_96, final)) < 0) \ + || !SAFE_CHARSET_P (coding, id)) \ + { \ + CODING_ISO_DESIGNATION (coding, reg) = -2; \ + chars_96 = -1; \ + break; \ + } \ + prev = CODING_ISO_DESIGNATION (coding, reg); \ + if (id == charset_jisx0201_roman) \ + { \ + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \ + id = charset_ascii; \ + } \ + else if (id == charset_jisx0208_1978) \ + { \ + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \ + id = charset_jisx0208; \ + } \ + CODING_ISO_DESIGNATION (coding, reg) = id; \ + /* If there was an invalid designation to REG previously, and this \ + designation is ASCII to REG, we should keep this designation \ + sequence. */ \ + if (prev == -2 && id == charset_ascii) \ + chars_96 = -1; \ } while (0) -/* Allocate a memory block for storing information about compositions. - The block is chained to the already allocated blocks. */ -void -coding_allocate_composition_data (coding, char_offset) - struct coding_system *coding; - int char_offset; -{ - struct composition_data *cmp_data - = (struct composition_data *) xmalloc (sizeof *cmp_data); - - cmp_data->char_offset = char_offset; - cmp_data->used = 0; - cmp_data->prev = coding->cmp_data; - cmp_data->next = NULL; - if (coding->cmp_data) - coding->cmp_data->next = cmp_data; - coding->cmp_data = cmp_data; - coding->cmp_data_start = 0; - coding->composing = COMPOSITION_NO; -} +#define MAYBE_FINISH_COMPOSITION() \ + do { \ + int i; \ + if (composition_state == COMPOSING_NO) \ + break; \ + /* It is assured that we have enough room for producing \ + characters stored in the table `components'. */ \ + if (charbuf + component_idx > charbuf_end) \ + goto no_more_source; \ + composition_state = COMPOSING_NO; \ + if (method == COMPOSITION_RELATIVE \ + || method == COMPOSITION_WITH_ALTCHARS) \ + { \ + for (i = 0; i < component_idx; i++) \ + *charbuf++ = components[i]; \ + char_offset += component_idx; \ + } \ + else \ + { \ + for (i = 0; i < component_idx; i += 2) \ + *charbuf++ = components[i]; \ + char_offset += (component_idx / 2) + 1; \ + } \ + } while (0) + /* Handle composition start sequence ESC 0, ESC 2, ESC 3, or ESC 4. ESC 0 : relative composition : ESC 0 CHAR ... ESC 1 ESC 2 : rulebase composition : ESC 2 CHAR RULE CHAR RULE ... CHAR ESC 1 - ESC 3 : altchar composition : ESC 3 ALT ... ESC 0 CHAR ... ESC 1 - ESC 4 : alt&rule composition : ESC 4 ALT RULE .. ALT ESC 0 CHAR ... ESC 1 + ESC 3 : altchar composition : ESC 3 CHAR ... ESC 0 CHAR ... ESC 1 + ESC 4 : alt&rule composition : ESC 4 CHAR RULE ... CHAR ESC 0 CHAR ... ESC 1 */ -#define DECODE_COMPOSITION_START(c1) \ - do { \ - if (coding->composing == COMPOSITION_DISABLED) \ - { \ - *dst++ = ISO_CODE_ESC; \ - *dst++ = c1 & 0x7f; \ - coding->produced_char += 2; \ - } \ - else if (!COMPOSING_P (coding)) \ - { \ - /* This is surely the start of a composition. We must be sure \ - that coding->cmp_data has enough space to store the \ - information about the composition. If not, terminate the \ - current decoding loop, allocate one more memory block for \ - coding->cmp_data in the caller, then start the decoding \ - loop again. We can't allocate memory here directly because \ - it may cause buffer/string relocation. */ \ - if (!coding->cmp_data \ - || (coding->cmp_data->used + COMPOSITION_DATA_MAX_BUNCH_LENGTH \ - >= COMPOSITION_DATA_SIZE)) \ - { \ - coding->result = CODING_FINISH_INSUFFICIENT_CMP; \ - goto label_end_of_loop; \ - } \ - coding->composing = (c1 == '0' ? COMPOSITION_RELATIVE \ - : c1 == '2' ? COMPOSITION_WITH_RULE \ - : c1 == '3' ? COMPOSITION_WITH_ALTCHARS \ - : COMPOSITION_WITH_RULE_ALTCHARS); \ - CODING_ADD_COMPOSITION_START (coding, coding->produced_char, \ - coding->composing); \ - coding->composition_rule_follows = 0; \ - } \ - else \ - { \ - /* We are already handling a composition. If the method is \ - the following two, the codes following the current escape \ - sequence are actual characters stored in a buffer. */ \ - if (coding->composing == COMPOSITION_WITH_ALTCHARS \ - || coding->composing == COMPOSITION_WITH_RULE_ALTCHARS) \ - { \ - coding->composing = COMPOSITION_RELATIVE; \ - coding->composition_rule_follows = 0; \ - } \ - } \ +#define DECODE_COMPOSITION_START(c1) \ + do { \ + if (c1 == '0' \ + && composition_state == COMPOSING_COMPONENT_RULE) \ + { \ + component_len = component_idx; \ + composition_state = COMPOSING_CHAR; \ + } \ + else \ + { \ + const unsigned char *p; \ + \ + MAYBE_FINISH_COMPOSITION (); \ + if (charbuf + MAX_COMPOSITION_COMPONENTS > charbuf_end) \ + goto no_more_source; \ + for (p = src; p < src_end - 1; p++) \ + if (*p == ISO_CODE_ESC && p[1] == '1') \ + break; \ + if (p == src_end - 1) \ + { \ + /* The current composition doesn't end in the current \ + source. */ \ + record_conversion_result \ + (coding, CODING_RESULT_INSUFFICIENT_SRC); \ + goto no_more_source; \ + } \ + \ + /* This is surely the start of a composition. */ \ + method = (c1 == '0' ? COMPOSITION_RELATIVE \ + : c1 == '2' ? COMPOSITION_WITH_RULE \ + : c1 == '3' ? COMPOSITION_WITH_ALTCHARS \ + : COMPOSITION_WITH_RULE_ALTCHARS); \ + composition_state = (c1 <= '2' ? COMPOSING_CHAR \ + : COMPOSING_COMPONENT_CHAR); \ + component_idx = component_len = 0; \ + } \ } while (0) -/* Handle composition end sequence ESC 1. */ -#define DECODE_COMPOSITION_END(c1) \ +/* Handle compositoin end sequence ESC 1. */ + +#define DECODE_COMPOSITION_END() \ do { \ - if (! COMPOSING_P (coding)) \ + int nchars = (component_len > 0 ? component_idx - component_len \ + : method == COMPOSITION_RELATIVE ? component_idx \ + : (component_idx + 1) / 2); \ + int i; \ + int *saved_charbuf = charbuf; \ + \ + ADD_COMPOSITION_DATA (charbuf, nchars, method); \ + if (method != COMPOSITION_RELATIVE) \ { \ - *dst++ = ISO_CODE_ESC; \ - *dst++ = c1; \ - coding->produced_char += 2; \ + if (component_len == 0) \ + for (i = 0; i < component_idx; i++) \ + *charbuf++ = components[i]; \ + else \ + for (i = 0; i < component_len; i++) \ + *charbuf++ = components[i]; \ + *saved_charbuf = saved_charbuf - charbuf; \ } \ + if (method == COMPOSITION_WITH_RULE) \ + for (i = 0; i < component_idx; i += 2, char_offset++) \ + *charbuf++ = components[i]; \ else \ - { \ - CODING_ADD_COMPOSITION_END (coding, coding->produced_char); \ - coding->composing = COMPOSITION_NO; \ - } \ + for (i = component_len; i < component_idx; i++, char_offset++) \ + *charbuf++ = components[i]; \ + coding->annotated = 1; \ + composition_state = COMPOSING_NO; \ } while (0) + /* Decode a composition rule from the byte C1 (and maybe one more byte from SRC) and store one encoded composition rule in coding->cmp_data. */ #define DECODE_COMPOSITION_RULE(c1) \ do { \ - int rule = 0; \ (c1) -= 32; \ if (c1 < 81) /* old format (before ver.21) */ \ { \ @@ -1804,168 +2897,164 @@ coding_allocate_composition_data (coding, char_offset) int nref = (c1) % 9; \ if (gref == 4) gref = 10; \ if (nref == 4) nref = 10; \ - rule = COMPOSITION_ENCODE_RULE (gref, nref); \ + c1 = COMPOSITION_ENCODE_RULE (gref, nref); \ } \ else if (c1 < 93) /* new format (after ver.21) */ \ { \ ONE_MORE_BYTE (c2); \ - rule = COMPOSITION_ENCODE_RULE (c1 - 81, c2 - 32); \ + c1 = COMPOSITION_ENCODE_RULE (c1 - 81, c2 - 32); \ } \ - CODING_ADD_COMPOSITION_COMPONENT (coding, rule); \ - coding->composition_rule_follows = 0; \ + else \ + c1 = 0; \ } while (0) /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */ static void -decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) +decode_coding_iso_2022 (coding) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; { - const unsigned char *src = source; - const unsigned char *src_end = source + src_bytes; - unsigned char *dst = destination; - unsigned char *dst_end = destination + dst_bytes; - /* Charsets invoked to graphic plane 0 and 1 respectively. */ - int charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0); - int charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1); - /* SRC_BASE remembers the start position in source in each loop. - The loop will be exited when there's not enough source code - (within macro ONE_MORE_BYTE), or when there's not enough - destination area to produce a character (within macro - EMIT_CHAR). */ + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; const unsigned char *src_base; - int c, charset; - Lisp_Object translation_table; - Lisp_Object safe_chars; - - safe_chars = coding_safe_chars (coding->symbol); - - if (NILP (Venable_character_translation)) - translation_table = Qnil; - else - { - translation_table = coding->translation_table_for_decode; - if (NILP (translation_table)) - translation_table = Vstandard_translation_table_for_decode; - } - - coding->result = CODING_FINISH_NORMAL; + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end + = coding->charbuf + coding->charbuf_size - 4 - MAX_ANNOTATION_LENGTH; + int consumed_chars = 0, consumed_chars_base; + int multibytep = coding->src_multibyte; + /* Charsets invoked to graphic plane 0 and 1 respectively. */ + int charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0); + int charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1); + int charset_id_2, charset_id_3; + struct charset *charset; + int c; + /* For handling composition sequence. */ +#define COMPOSING_NO 0 +#define COMPOSING_CHAR 1 +#define COMPOSING_RULE 2 +#define COMPOSING_COMPONENT_CHAR 3 +#define COMPOSING_COMPONENT_RULE 4 + + int composition_state = COMPOSING_NO; + enum composition_method method; + int components[MAX_COMPOSITION_COMPONENTS * 2 + 1]; + int component_idx; + int component_len; + Lisp_Object attrs, charset_list; + int char_offset = coding->produced_char; + int last_offset = char_offset; + int last_id = charset_ascii; + + CODING_GET_INFO (coding, attrs, charset_list); + setup_iso_safe_charsets (attrs); + /* Charset list may have been changed. */ + charset_list = CODING_ATTR_CHARSET_LIST (attrs); + coding->safe_charsets = (char *) SDATA (CODING_ATTR_SAFE_CHARSETS(attrs)); while (1) { - int c1, c2 = 0; + int c1, c2; src_base = src; + consumed_chars_base = consumed_chars; + + if (charbuf >= charbuf_end) + break; + ONE_MORE_BYTE (c1); + if (c1 < 0) + goto invalid_code; - /* We produce no character or one character. */ + /* We produce at most one character. */ switch (iso_code_class [c1]) { case ISO_0x20_or_0x7F: - if (COMPOSING_P (coding) && coding->composition_rule_follows) - { - DECODE_COMPOSITION_RULE (c1); - continue; - } - if (charset0 < 0 || CHARSET_CHARS (charset0) == 94) + if (composition_state != COMPOSING_NO) { - /* This is SPACE or DEL. */ - charset = CHARSET_ASCII; - break; + if (composition_state == COMPOSING_RULE + || composition_state == COMPOSING_COMPONENT_RULE) + { + DECODE_COMPOSITION_RULE (c1); + components[component_idx++] = c1; + composition_state--; + continue; + } } - /* This is a graphic character, we fall down ... */ + if (charset_id_0 < 0 + || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_0))) + /* This is SPACE or DEL. */ + charset = CHARSET_FROM_ID (charset_ascii); + else + charset = CHARSET_FROM_ID (charset_id_0); + break; case ISO_graphic_plane_0: - if (COMPOSING_P (coding) && coding->composition_rule_follows) + if (composition_state != COMPOSING_NO) { - DECODE_COMPOSITION_RULE (c1); - continue; + if (composition_state == COMPOSING_RULE + || composition_state == COMPOSING_COMPONENT_RULE) + { + DECODE_COMPOSITION_RULE (c1); + components[component_idx++] = c1; + composition_state--; + continue; + } } - charset = charset0; + if (charset_id_0 < 0) + charset = CHARSET_FROM_ID (charset_ascii); + else + charset = CHARSET_FROM_ID (charset_id_0); break; case ISO_0xA0_or_0xFF: - if (charset1 < 0 || CHARSET_CHARS (charset1) == 94 - || coding->flags & CODING_FLAG_ISO_SEVEN_BITS) - goto label_invalid_code; + if (charset_id_1 < 0 + || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_1)) + || CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) + goto invalid_code; /* This is a graphic character, we fall down ... */ case ISO_graphic_plane_1: - if (charset1 < 0) - goto label_invalid_code; - charset = charset1; + if (charset_id_1 < 0) + goto invalid_code; + charset = CHARSET_FROM_ID (charset_id_1); break; case ISO_control_0: - if (COMPOSING_P (coding)) - DECODE_COMPOSITION_END ('1'); - - /* All ISO2022 control characters in this class have the - same representation in Emacs internal format. */ - if (c1 == '\n' - && (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL) - && (coding->eol_type == CODING_EOL_CR - || coding->eol_type == CODING_EOL_CRLF)) - { - coding->result = CODING_FINISH_INCONSISTENT_EOL; - goto label_end_of_loop; - } - charset = CHARSET_ASCII; + MAYBE_FINISH_COMPOSITION (); + charset = CHARSET_FROM_ID (charset_ascii); break; case ISO_control_1: - if (COMPOSING_P (coding)) - DECODE_COMPOSITION_END ('1'); - goto label_invalid_code; - - case ISO_carriage_return: - if (COMPOSING_P (coding)) - DECODE_COMPOSITION_END ('1'); - - if (coding->eol_type == CODING_EOL_CR) - c1 = '\n'; - else if (coding->eol_type == CODING_EOL_CRLF) - { - ONE_MORE_BYTE (c1); - if (c1 != ISO_CODE_LF) - { - src--; - c1 = '\r'; - } - } - charset = CHARSET_ASCII; - break; + MAYBE_FINISH_COMPOSITION (); + goto invalid_code; case ISO_shift_out: - if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT) - || CODING_SPEC_ISO_DESIGNATION (coding, 1) < 0) - goto label_invalid_code; - CODING_SPEC_ISO_INVOCATION (coding, 0) = 1; - charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0); + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT) + || CODING_ISO_DESIGNATION (coding, 1) < 0) + goto invalid_code; + CODING_ISO_INVOCATION (coding, 0) = 1; + charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0); continue; case ISO_shift_in: - if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT)) - goto label_invalid_code; - CODING_SPEC_ISO_INVOCATION (coding, 0) = 0; - charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0); + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)) + goto invalid_code; + CODING_ISO_INVOCATION (coding, 0) = 0; + charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0); continue; case ISO_single_shift_2_7: case ISO_single_shift_2: - if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)) - goto label_invalid_code; + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)) + goto invalid_code; /* SS2 is handled as an escape sequence of ESC 'N' */ c1 = 'N'; goto label_escape_sequence; case ISO_single_shift_3: - if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)) - goto label_invalid_code; + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)) + goto invalid_code; /* SS2 is handled as an escape sequence of ESC 'O' */ c1 = 'O'; goto label_escape_sequence; @@ -1978,7 +3067,7 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) case ISO_escape: ONE_MORE_BYTE (c1); label_escape_sequence: - /* Escape sequences handled by Emacs are invocation, + /* Escape sequences handled here are invocation, designation, direction specification, and character composition specification. */ switch (c1) @@ -1986,89 +3075,110 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) case '&': /* revision of following character set */ ONE_MORE_BYTE (c1); if (!(c1 >= '@' && c1 <= '~')) - goto label_invalid_code; + goto invalid_code; ONE_MORE_BYTE (c1); if (c1 != ISO_CODE_ESC) - goto label_invalid_code; + goto invalid_code; ONE_MORE_BYTE (c1); goto label_escape_sequence; case '$': /* designation of 2-byte character set */ - if (! (coding->flags & CODING_FLAG_ISO_DESIGNATION)) - goto label_invalid_code; - ONE_MORE_BYTE (c1); - if (c1 >= '@' && c1 <= 'B') - { /* designation of JISX0208.1978, GB2312.1980, + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION)) + goto invalid_code; + { + int reg, chars96; + + ONE_MORE_BYTE (c1); + if (c1 >= '@' && c1 <= 'B') + { /* designation of JISX0208.1978, GB2312.1980, or JISX0208.1980 */ - DECODE_DESIGNATION (0, 2, 94, c1); - } - else if (c1 >= 0x28 && c1 <= 0x2B) - { /* designation of DIMENSION2_CHARS94 character set */ - ONE_MORE_BYTE (c2); - DECODE_DESIGNATION (c1 - 0x28, 2, 94, c2); - } - else if (c1 >= 0x2C && c1 <= 0x2F) - { /* designation of DIMENSION2_CHARS96 character set */ - ONE_MORE_BYTE (c2); - DECODE_DESIGNATION (c1 - 0x2C, 2, 96, c2); - } - else - goto label_invalid_code; - /* We must update these variables now. */ - charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0); - charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1); + reg = 0, chars96 = 0; + } + else if (c1 >= 0x28 && c1 <= 0x2B) + { /* designation of DIMENSION2_CHARS94 character set */ + reg = c1 - 0x28, chars96 = 0; + ONE_MORE_BYTE (c1); + } + else if (c1 >= 0x2C && c1 <= 0x2F) + { /* designation of DIMENSION2_CHARS96 character set */ + reg = c1 - 0x2C, chars96 = 1; + ONE_MORE_BYTE (c1); + } + else + goto invalid_code; + DECODE_DESIGNATION (reg, 2, chars96, c1); + /* We must update these variables now. */ + if (reg == 0) + charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0); + else if (reg == 1) + charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1); + if (chars96 < 0) + goto invalid_code; + } continue; case 'n': /* invocation of locking-shift-2 */ - if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT) - || CODING_SPEC_ISO_DESIGNATION (coding, 2) < 0) - goto label_invalid_code; - CODING_SPEC_ISO_INVOCATION (coding, 0) = 2; - charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0); + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT) + || CODING_ISO_DESIGNATION (coding, 2) < 0) + goto invalid_code; + CODING_ISO_INVOCATION (coding, 0) = 2; + charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0); continue; case 'o': /* invocation of locking-shift-3 */ - if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT) - || CODING_SPEC_ISO_DESIGNATION (coding, 3) < 0) - goto label_invalid_code; - CODING_SPEC_ISO_INVOCATION (coding, 0) = 3; - charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0); + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT) + || CODING_ISO_DESIGNATION (coding, 3) < 0) + goto invalid_code; + CODING_ISO_INVOCATION (coding, 0) = 3; + charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0); continue; case 'N': /* invocation of single-shift-2 */ - if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT) - || CODING_SPEC_ISO_DESIGNATION (coding, 2) < 0) - goto label_invalid_code; - charset = CODING_SPEC_ISO_DESIGNATION (coding, 2); + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT) + || CODING_ISO_DESIGNATION (coding, 2) < 0) + goto invalid_code; + charset_id_2 = CODING_ISO_DESIGNATION (coding, 2); + if (charset_id_2 < 0) + charset = CHARSET_FROM_ID (charset_ascii); + else + charset = CHARSET_FROM_ID (charset_id_2); ONE_MORE_BYTE (c1); if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0)) - goto label_invalid_code; + goto invalid_code; break; case 'O': /* invocation of single-shift-3 */ - if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT) - || CODING_SPEC_ISO_DESIGNATION (coding, 3) < 0) - goto label_invalid_code; - charset = CODING_SPEC_ISO_DESIGNATION (coding, 3); + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT) + || CODING_ISO_DESIGNATION (coding, 3) < 0) + goto invalid_code; + charset_id_3 = CODING_ISO_DESIGNATION (coding, 3); + if (charset_id_3 < 0) + charset = CHARSET_FROM_ID (charset_ascii); + else + charset = CHARSET_FROM_ID (charset_id_3); ONE_MORE_BYTE (c1); if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0)) - goto label_invalid_code; + goto invalid_code; break; case '0': case '2': case '3': case '4': /* start composition */ + if (! (coding->common_flags & CODING_ANNOTATE_COMPOSITION_MASK)) + goto invalid_code; DECODE_COMPOSITION_START (c1); continue; case '1': /* end composition */ - DECODE_COMPOSITION_END (c1); + if (composition_state == COMPOSING_NO) + goto invalid_code; + DECODE_COMPOSITION_END (); continue; case '[': /* specification of direction */ - if (coding->flags & CODING_FLAG_ISO_NO_DIRECTION) - goto label_invalid_code; + if (! CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DIRECTION) + goto invalid_code; /* For the moment, nested direction is not supported. So, `coding->mode & CODING_MODE_DIRECTION' zero means - left-to-right, and nonzero means right-to-left. */ + left-to-right, and nozero means right-to-left. */ ONE_MORE_BYTE (c1); switch (c1) { @@ -2081,7 +3191,7 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) if (c1 == ']') coding->mode &= ~CODING_MODE_DIRECTION; else - goto label_invalid_code; + goto invalid_code; break; case '2': /* start of right-to-left direction */ @@ -2089,17 +3199,15 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) if (c1 == ']') coding->mode |= CODING_MODE_DIRECTION; else - goto label_invalid_code; + goto invalid_code; break; default: - goto label_invalid_code; + goto invalid_code; } continue; case '%': - if (COMPOSING_P (coding)) - DECODE_COMPOSITION_END ('1'); ONE_MORE_BYTE (c1); if (c1 == '/') { @@ -2108,46 +3216,40 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) We keep these bytes as is for the moment. They may be decoded by post-read-conversion. */ int dim, M, L; - int size, required; - int produced_chars; + int size; ONE_MORE_BYTE (dim); ONE_MORE_BYTE (M); ONE_MORE_BYTE (L); size = ((M - 128) * 128) + (L - 128); - required = 8 + size * 2; - if (dst + required > (dst_bytes ? dst_end : src)) - goto label_end_of_loop; - *dst++ = ISO_CODE_ESC; - *dst++ = '%'; - *dst++ = '/'; - *dst++ = dim; - produced_chars = 4; - dst += CHAR_STRING (M, dst), produced_chars++; - dst += CHAR_STRING (L, dst), produced_chars++; + if (charbuf + 8 + size > charbuf_end) + goto break_loop; + *charbuf++ = ISO_CODE_ESC; + *charbuf++ = '%'; + *charbuf++ = '/'; + *charbuf++ = dim; + *charbuf++ = BYTE8_TO_CHAR (M); + *charbuf++ = BYTE8_TO_CHAR (L); while (size-- > 0) { ONE_MORE_BYTE (c1); - dst += CHAR_STRING (c1, dst), produced_chars++; + *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1); } - coding->produced_char += produced_chars; } else if (c1 == 'G') { - unsigned char *d = dst; - int produced_chars; - /* XFree86 extension for embedding UTF-8 in CTEXT: ESC % G --UTF-8-BYTES-- ESC % @ We keep these bytes as is for the moment. They may be decoded by post-read-conversion. */ - if (d + 6 > (dst_bytes ? dst_end : src)) - goto label_end_of_loop; - *d++ = ISO_CODE_ESC; - *d++ = '%'; - *d++ = 'G'; - produced_chars = 3; - while (d + 1 < (dst_bytes ? dst_end : src)) + int *p = charbuf; + + if (p + 6 > charbuf_end) + goto break_loop; + *p++ = ISO_CODE_ESC; + *p++ = '%'; + *p++ = 'G'; + while (p < charbuf_end) { ONE_MORE_BYTE (c1); if (c1 == ISO_CODE_ESC @@ -2158,71 +3260,128 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) src += 2; break; } - d += CHAR_STRING (c1, d), produced_chars++; + *p++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1); } - if (d + 3 > (dst_bytes ? dst_end : src)) - goto label_end_of_loop; - *d++ = ISO_CODE_ESC; - *d++ = '%'; - *d++ = '@'; - dst = d; - coding->produced_char += produced_chars + 3; + if (p + 3 > charbuf_end) + goto break_loop; + *p++ = ISO_CODE_ESC; + *p++ = '%'; + *p++ = '@'; + charbuf = p; } else - goto label_invalid_code; + goto invalid_code; continue; + break; default: - if (! (coding->flags & CODING_FLAG_ISO_DESIGNATION)) - goto label_invalid_code; - if (c1 >= 0x28 && c1 <= 0x2B) - { /* designation of DIMENSION1_CHARS94 character set */ - ONE_MORE_BYTE (c2); - DECODE_DESIGNATION (c1 - 0x28, 1, 94, c2); - } - else if (c1 >= 0x2C && c1 <= 0x2F) - { /* designation of DIMENSION1_CHARS96 character set */ - ONE_MORE_BYTE (c2); - DECODE_DESIGNATION (c1 - 0x2C, 1, 96, c2); - } - else - goto label_invalid_code; - /* We must update these variables now. */ - charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0); - charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1); + if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION)) + goto invalid_code; + { + int reg, chars96; + + if (c1 >= 0x28 && c1 <= 0x2B) + { /* designation of DIMENSION1_CHARS94 character set */ + reg = c1 - 0x28, chars96 = 0; + ONE_MORE_BYTE (c1); + } + else if (c1 >= 0x2C && c1 <= 0x2F) + { /* designation of DIMENSION1_CHARS96 character set */ + reg = c1 - 0x2C, chars96 = 1; + ONE_MORE_BYTE (c1); + } + else + goto invalid_code; + DECODE_DESIGNATION (reg, 1, chars96, c1); + /* We must update these variables now. */ + if (reg == 0) + charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0); + else if (reg == 1) + charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1); + if (chars96 < 0) + goto invalid_code; + } continue; } } + if (charset->id != charset_ascii + && last_id != charset->id) + { + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + last_id = charset->id; + last_offset = char_offset; + } + /* Now we know CHARSET and 1st position code C1 of a character. - Produce a multibyte sequence for that character while getting - 2nd position code C2 if necessary. */ - if (CHARSET_DIMENSION (charset) == 2) + Produce a decoded character while getting 2nd position code + C2 if necessary. */ + c1 &= 0x7F; + if (CHARSET_DIMENSION (charset) > 1) { ONE_MORE_BYTE (c2); - if (c1 < 0x80 ? c2 < 0x20 || c2 >= 0x80 : c2 < 0xA0) + if (c2 < 0x20 || (c2 >= 0x80 && c2 < 0xA0)) /* C2 is not in a valid range. */ - goto label_invalid_code; + goto invalid_code; + c1 = (c1 << 8) | (c2 & 0x7F); + if (CHARSET_DIMENSION (charset) > 2) + { + ONE_MORE_BYTE (c2); + if (c2 < 0x20 || (c2 >= 0x80 && c2 < 0xA0)) + /* C2 is not in a valid range. */ + goto invalid_code; + c1 = (c1 << 8) | (c2 & 0x7F); + } + } + + CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c1, c); + if (c < 0) + { + MAYBE_FINISH_COMPOSITION (); + for (; src_base < src; src_base++, char_offset++) + { + if (ASCII_BYTE_P (*src_base)) + *charbuf++ = *src_base; + else + *charbuf++ = BYTE8_TO_CHAR (*src_base); + } + } + else if (composition_state == COMPOSING_NO) + { + *charbuf++ = c; + char_offset++; + } + else + { + components[component_idx++] = c; + if (method == COMPOSITION_WITH_RULE + || (method == COMPOSITION_WITH_RULE_ALTCHARS + && composition_state == COMPOSING_COMPONENT_CHAR)) + composition_state++; } - c = DECODE_ISO_CHARACTER (charset, c1, c2); - EMIT_CHAR (c); continue; - label_invalid_code: - coding->errors++; - if (COMPOSING_P (coding)) - DECODE_COMPOSITION_END ('1'); + invalid_code: + MAYBE_FINISH_COMPOSITION (); src = src_base; - c = *src++; - if (! NILP (translation_table)) - c = translate_char (translation_table, c, 0, 0, 0); - EMIT_CHAR (c); + consumed_chars = consumed_chars_base; + ONE_MORE_BYTE (c); + *charbuf++ = c < 0 ? -c : ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c); + char_offset++; + coding->errors++; + continue; + + break_loop: + break; } - label_end_of_loop: - coding->consumed = coding->consumed_char = src_base - source; - coding->produced = dst - destination; - return; + no_more_source: + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + coding->consumed_char += consumed_chars_base; + coding->consumed = src_base - coding->source; + coding->charbuf_used = charbuf - coding->charbuf; } @@ -2230,9 +3389,9 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) /* It is not enough to say just "ISO2022" on encoding, we have to - specify more details. In Emacs, each ISO2022 coding system + specify more details. In Emacs, each coding system of ISO2022 variant has the following specifications: - 1. Initial designation to G0 through G3. + 1. Initial designation to G0 thru G3. 2. Allows short-form designation? 3. ASCII should be designated to G0 before control characters? 4. ASCII should be designated to G0 at end of line? @@ -2242,8 +3401,8 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) And the following two are only for Japanese: 8. Use ASCII in place of JIS0201-1976-Roman? 9. Use JISX0208-1983 in place of JISX0208-1978? - These specifications are encoded in `coding->flags' as flag bits - defined by macros CODING_FLAG_ISO_XXX. See `coding.h' for more + These specifications are encoded in CODING_ISO_FLAGS (coding) as flag bits + defined by macros CODING_ISO_FLAG_XXX. See `coding.h' for more details. */ @@ -2254,115 +3413,136 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) #define ENCODE_DESIGNATION(charset, reg, coding) \ do { \ - unsigned char final_char = CHARSET_ISO_FINAL_CHAR (charset); \ + unsigned char final_char = CHARSET_ISO_FINAL (charset); \ char *intermediate_char_94 = "()*+"; \ char *intermediate_char_96 = ",-./"; \ - int revision = CODING_SPEC_ISO_REVISION_NUMBER(coding, charset); \ - \ - if (revision < 255) \ + int revision = -1; \ + int c; \ + \ + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_REVISION) \ + revision = CHARSET_ISO_REVISION (charset); \ + \ + if (revision >= 0) \ { \ - *dst++ = ISO_CODE_ESC; \ - *dst++ = '&'; \ - *dst++ = '@' + revision; \ + EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '&'); \ + EMIT_ONE_BYTE ('@' + revision); \ } \ - *dst++ = ISO_CODE_ESC; \ + EMIT_ONE_ASCII_BYTE (ISO_CODE_ESC); \ if (CHARSET_DIMENSION (charset) == 1) \ { \ - if (CHARSET_CHARS (charset) == 94) \ - *dst++ = (unsigned char) (intermediate_char_94[reg]); \ + if (! CHARSET_ISO_CHARS_96 (charset)) \ + c = intermediate_char_94[reg]; \ else \ - *dst++ = (unsigned char) (intermediate_char_96[reg]); \ + c = intermediate_char_96[reg]; \ + EMIT_ONE_ASCII_BYTE (c); \ } \ else \ { \ - *dst++ = '$'; \ - if (CHARSET_CHARS (charset) == 94) \ + EMIT_ONE_ASCII_BYTE ('$'); \ + if (! CHARSET_ISO_CHARS_96 (charset)) \ { \ - if (! (coding->flags & CODING_FLAG_ISO_SHORT_FORM) \ + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LONG_FORM \ || reg != 0 \ || final_char < '@' || final_char > 'B') \ - *dst++ = (unsigned char) (intermediate_char_94[reg]); \ + EMIT_ONE_ASCII_BYTE (intermediate_char_94[reg]); \ } \ else \ - *dst++ = (unsigned char) (intermediate_char_96[reg]); \ + EMIT_ONE_ASCII_BYTE (intermediate_char_96[reg]); \ } \ - *dst++ = final_char; \ - CODING_SPEC_ISO_DESIGNATION (coding, reg) = charset; \ + EMIT_ONE_ASCII_BYTE (final_char); \ + \ + CODING_ISO_DESIGNATION (coding, reg) = CHARSET_ID (charset); \ } while (0) + /* The following two macros produce codes (control character or escape sequence) for ISO2022 single-shift functions (single-shift-2 and single-shift-3). */ -#define ENCODE_SINGLE_SHIFT_2 \ - do { \ - if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \ - *dst++ = ISO_CODE_ESC, *dst++ = 'N'; \ - else \ - *dst++ = ISO_CODE_SS2; \ - CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 1; \ +#define ENCODE_SINGLE_SHIFT_2 \ + do { \ + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \ + EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'N'); \ + else \ + EMIT_ONE_BYTE (ISO_CODE_SS2); \ + CODING_ISO_SINGLE_SHIFTING (coding) = 1; \ } while (0) -#define ENCODE_SINGLE_SHIFT_3 \ - do { \ - if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \ - *dst++ = ISO_CODE_ESC, *dst++ = 'O'; \ - else \ - *dst++ = ISO_CODE_SS3; \ - CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 1; \ + +#define ENCODE_SINGLE_SHIFT_3 \ + do { \ + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \ + EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'O'); \ + else \ + EMIT_ONE_BYTE (ISO_CODE_SS3); \ + CODING_ISO_SINGLE_SHIFTING (coding) = 1; \ } while (0) + /* The following four macros produce codes (control character or escape sequence) for ISO2022 locking-shift functions (shift-in, shift-out, locking-shift-2, and locking-shift-3). */ -#define ENCODE_SHIFT_IN \ - do { \ - *dst++ = ISO_CODE_SI; \ - CODING_SPEC_ISO_INVOCATION (coding, 0) = 0; \ +#define ENCODE_SHIFT_IN \ + do { \ + EMIT_ONE_ASCII_BYTE (ISO_CODE_SI); \ + CODING_ISO_INVOCATION (coding, 0) = 0; \ } while (0) -#define ENCODE_SHIFT_OUT \ - do { \ - *dst++ = ISO_CODE_SO; \ - CODING_SPEC_ISO_INVOCATION (coding, 0) = 1; \ + +#define ENCODE_SHIFT_OUT \ + do { \ + EMIT_ONE_ASCII_BYTE (ISO_CODE_SO); \ + CODING_ISO_INVOCATION (coding, 0) = 1; \ } while (0) -#define ENCODE_LOCKING_SHIFT_2 \ - do { \ - *dst++ = ISO_CODE_ESC, *dst++ = 'n'; \ - CODING_SPEC_ISO_INVOCATION (coding, 0) = 2; \ + +#define ENCODE_LOCKING_SHIFT_2 \ + do { \ + EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \ + CODING_ISO_INVOCATION (coding, 0) = 2; \ } while (0) -#define ENCODE_LOCKING_SHIFT_3 \ - do { \ - *dst++ = ISO_CODE_ESC, *dst++ = 'o'; \ - CODING_SPEC_ISO_INVOCATION (coding, 0) = 3; \ + +#define ENCODE_LOCKING_SHIFT_3 \ + do { \ + EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \ + CODING_ISO_INVOCATION (coding, 0) = 3; \ } while (0) + /* Produce codes for a DIMENSION1 character whose character set is CHARSET and whose position-code is C1. Designation and invocation sequences are also produced in advance if necessary. */ #define ENCODE_ISO_CHARACTER_DIMENSION1(charset, c1) \ do { \ - if (CODING_SPEC_ISO_SINGLE_SHIFTING (coding)) \ + int id = CHARSET_ID (charset); \ + \ + if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \ + && id == charset_ascii) \ { \ - if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \ - *dst++ = c1 & 0x7F; \ + id = charset_jisx0201_roman; \ + charset = CHARSET_FROM_ID (id); \ + } \ + \ + if (CODING_ISO_SINGLE_SHIFTING (coding)) \ + { \ + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \ + EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \ else \ - *dst++ = c1 | 0x80; \ - CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 0; \ + EMIT_ONE_BYTE (c1 | 0x80); \ + CODING_ISO_SINGLE_SHIFTING (coding) = 0; \ break; \ } \ - else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 0)) \ + else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \ { \ - *dst++ = c1 & 0x7F; \ + EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \ break; \ } \ - else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 1)) \ + else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \ { \ - *dst++ = c1 | 0x80; \ + EMIT_ONE_BYTE (c1 | 0x80); \ break; \ } \ else \ @@ -2370,32 +3550,43 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) must invoke it, or, at first, designate it to some graphic \ register. Then repeat the loop to actually produce the \ character. */ \ - dst = encode_invocation_designation (charset, coding, dst); \ + dst = encode_invocation_designation (charset, coding, dst, \ + &produced_chars); \ } while (1) + /* Produce codes for a DIMENSION2 character whose character set is CHARSET and whose position-codes are C1 and C2. Designation and invocation codes are also produced in advance if necessary. */ #define ENCODE_ISO_CHARACTER_DIMENSION2(charset, c1, c2) \ do { \ - if (CODING_SPEC_ISO_SINGLE_SHIFTING (coding)) \ + int id = CHARSET_ID (charset); \ + \ + if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \ + && id == charset_jisx0208) \ + { \ + id = charset_jisx0208_1978; \ + charset = CHARSET_FROM_ID (id); \ + } \ + \ + if (CODING_ISO_SINGLE_SHIFTING (coding)) \ { \ - if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \ - *dst++ = c1 & 0x7F, *dst++ = c2 & 0x7F; \ + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \ + EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \ else \ - *dst++ = c1 | 0x80, *dst++ = c2 | 0x80; \ - CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 0; \ + EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \ + CODING_ISO_SINGLE_SHIFTING (coding) = 0; \ break; \ } \ - else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 0)) \ + else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \ { \ - *dst++ = c1 & 0x7F, *dst++= c2 & 0x7F; \ + EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \ break; \ } \ - else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 1)) \ + else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \ { \ - *dst++ = c1 | 0x80, *dst++= c2 | 0x80; \ + EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \ break; \ } \ else \ @@ -2403,73 +3594,49 @@ decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) must invoke it, or, at first, designate it to some graphic \ register. Then repeat the loop to actually produce the \ character. */ \ - dst = encode_invocation_designation (charset, coding, dst); \ + dst = encode_invocation_designation (charset, coding, dst, \ + &produced_chars); \ } while (1) -#define ENCODE_ISO_CHARACTER(c) \ - do { \ - int charset, c1, c2; \ - \ - SPLIT_CHAR (c, charset, c1, c2); \ - if (CHARSET_DEFINED_P (charset)) \ - { \ - if (CHARSET_DIMENSION (charset) == 1) \ - { \ - if (charset == CHARSET_ASCII \ - && coding->flags & CODING_FLAG_ISO_USE_ROMAN) \ - charset = charset_latin_jisx0201; \ - ENCODE_ISO_CHARACTER_DIMENSION1 (charset, c1); \ - } \ - else \ - { \ - if (charset == charset_jisx0208 \ - && coding->flags & CODING_FLAG_ISO_USE_OLDJIS) \ - charset = charset_jisx0208_1978; \ - ENCODE_ISO_CHARACTER_DIMENSION2 (charset, c1, c2); \ - } \ - } \ - else \ - { \ - *dst++ = c1; \ - if (c2 >= 0) \ - *dst++ = c2; \ - } \ - } while (0) - - -/* Instead of encoding character C, produce one or two `?'s. */ -#define ENCODE_UNSAFE_CHARACTER(c) \ - do { \ - ENCODE_ISO_CHARACTER (CODING_REPLACEMENT_CHARACTER); \ - if (CHARSET_WIDTH (CHAR_CHARSET (c)) > 1) \ - ENCODE_ISO_CHARACTER (CODING_REPLACEMENT_CHARACTER); \ +#define ENCODE_ISO_CHARACTER(charset, c) \ + do { \ + int code = ENCODE_CHAR ((charset),(c)); \ + \ + if (CHARSET_DIMENSION (charset) == 1) \ + ENCODE_ISO_CHARACTER_DIMENSION1 ((charset), code); \ + else \ + ENCODE_ISO_CHARACTER_DIMENSION2 ((charset), code >> 8, code & 0xFF); \ } while (0) /* Produce designation and invocation codes at a place pointed by DST - to use CHARSET. The element `spec.iso2022' of *CODING is updated. + to use CHARSET. The element `spec.iso_2022' of *CODING is updated. Return new DST. */ unsigned char * -encode_invocation_designation (charset, coding, dst) - int charset; +encode_invocation_designation (charset, coding, dst, p_nchars) + struct charset *charset; struct coding_system *coding; unsigned char *dst; + int *p_nchars; { + int multibytep = coding->dst_multibyte; + int produced_chars = *p_nchars; int reg; /* graphic register number */ + int id = CHARSET_ID (charset); /* At first, check designations. */ for (reg = 0; reg < 4; reg++) - if (charset == CODING_SPEC_ISO_DESIGNATION (coding, reg)) + if (id == CODING_ISO_DESIGNATION (coding, reg)) break; if (reg >= 4) { /* CHARSET is not yet designated to any graphic registers. */ /* At first check the requested designation. */ - reg = CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset); - if (reg == CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION) + reg = CODING_ISO_REQUEST (coding, id); + if (reg < 0) /* Since CHARSET requests no special designation, designate it to graphic register 0. */ reg = 0; @@ -2477,8 +3644,8 @@ encode_invocation_designation (charset, coding, dst) ENCODE_DESIGNATION (charset, reg, coding); } - if (CODING_SPEC_ISO_INVOCATION (coding, 0) != reg - && CODING_SPEC_ISO_INVOCATION (coding, 1) != reg) + if (CODING_ISO_INVOCATION (coding, 0) != reg + && CODING_ISO_INVOCATION (coding, 1) != reg) { /* Since the graphic register REG is not invoked to any graphic planes, invoke it to graphic plane 0. */ @@ -2493,14 +3660,14 @@ encode_invocation_designation (charset, coding, dst) break; case 2: /* graphic register 2 */ - if (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT) + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT) ENCODE_SINGLE_SHIFT_2; else ENCODE_LOCKING_SHIFT_2; break; case 3: /* graphic register 3 */ - if (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT) + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT) ENCODE_SINGLE_SHIFT_3; else ENCODE_LOCKING_SHIFT_3; @@ -2508,98 +3675,55 @@ encode_invocation_designation (charset, coding, dst) } } + *p_nchars = produced_chars; return dst; } -/* Produce 2-byte codes for encoded composition rule RULE. */ - -#define ENCODE_COMPOSITION_RULE(rule) \ - do { \ - int gref, nref; \ - COMPOSITION_DECODE_RULE (rule, gref, nref); \ - *dst++ = 32 + 81 + gref; \ - *dst++ = 32 + nref; \ - } while (0) - -/* Produce codes for indicating the start of a composition sequence - (ESC 0, ESC 3, or ESC 4). DATA points to an array of integers - which specify information about the composition. See the comment - in coding.h for the format of DATA. */ - -#define ENCODE_COMPOSITION_START(coding, data) \ +/* The following three macros produce codes for indicating direction + of text. */ +#define ENCODE_CONTROL_SEQUENCE_INTRODUCER \ do { \ - coding->composing = data[3]; \ - *dst++ = ISO_CODE_ESC; \ - if (coding->composing == COMPOSITION_RELATIVE) \ - *dst++ = '0'; \ + if (CODING_ISO_FLAGS (coding) == CODING_ISO_FLAG_SEVEN_BITS) \ + EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '['); \ else \ - { \ - *dst++ = (coding->composing == COMPOSITION_WITH_ALTCHARS \ - ? '3' : '4'); \ - coding->cmp_data_index = coding->cmp_data_start + 4; \ - coding->composition_rule_follows = 0; \ - } \ + EMIT_ONE_BYTE (ISO_CODE_CSI); \ } while (0) -/* Produce codes for indicating the end of the current composition. */ -#define ENCODE_COMPOSITION_END(coding, data) \ - do { \ - *dst++ = ISO_CODE_ESC; \ - *dst++ = '1'; \ - coding->cmp_data_start += data[0]; \ - coding->composing = COMPOSITION_NO; \ - if (coding->cmp_data_start == coding->cmp_data->used \ - && coding->cmp_data->next) \ - { \ - coding->cmp_data = coding->cmp_data->next; \ - coding->cmp_data_start = 0; \ - } \ +#define ENCODE_DIRECTION_R2L() \ + do { \ + ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst); \ + EMIT_TWO_ASCII_BYTES ('2', ']'); \ } while (0) -/* Produce composition start sequence ESC 0. Here, this sequence - doesn't mean the start of a new composition but means that we have - just produced components (alternate chars and composition rules) of - the composition and the actual text follows in SRC. */ -#define ENCODE_COMPOSITION_FAKE_START(coding) \ +#define ENCODE_DIRECTION_L2R() \ do { \ - *dst++ = ISO_CODE_ESC; \ - *dst++ = '0'; \ - coding->composing = COMPOSITION_RELATIVE; \ + ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst); \ + EMIT_TWO_ASCII_BYTES ('0', ']'); \ } while (0) -/* The following three macros produce codes for indicating direction - of text. */ -#define ENCODE_CONTROL_SEQUENCE_INTRODUCER \ - do { \ - if (coding->flags == CODING_FLAG_ISO_SEVEN_BITS) \ - *dst++ = ISO_CODE_ESC, *dst++ = '['; \ - else \ - *dst++ = ISO_CODE_CSI; \ - } while (0) - -#define ENCODE_DIRECTION_R2L \ - ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst), *dst++ = '2', *dst++ = ']' - -#define ENCODE_DIRECTION_L2R \ - ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst), *dst++ = '0', *dst++ = ']' /* Produce codes for designation and invocation to reset the graphic planes and registers to initial state. */ -#define ENCODE_RESET_PLANE_AND_REGISTER \ - do { \ - int reg; \ - if (CODING_SPEC_ISO_INVOCATION (coding, 0) != 0) \ - ENCODE_SHIFT_IN; \ - for (reg = 0; reg < 4; reg++) \ - if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg) >= 0 \ - && (CODING_SPEC_ISO_DESIGNATION (coding, reg) \ - != CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg))) \ - ENCODE_DESIGNATION \ - (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg), reg, coding); \ +#define ENCODE_RESET_PLANE_AND_REGISTER() \ + do { \ + int reg; \ + struct charset *charset; \ + \ + if (CODING_ISO_INVOCATION (coding, 0) != 0) \ + ENCODE_SHIFT_IN; \ + for (reg = 0; reg < 4; reg++) \ + if (CODING_ISO_INITIAL (coding, reg) >= 0 \ + && (CODING_ISO_DESIGNATION (coding, reg) \ + != CODING_ISO_INITIAL (coding, reg))) \ + { \ + charset = CHARSET_FROM_ID (CODING_ISO_INITIAL (coding, reg)); \ + ENCODE_DESIGNATION (charset, reg, coding); \ + } \ } while (0) + /* Produce designation sequences of charsets in the line started from SRC to a place pointed by DST, and return updated DST. @@ -2607,41 +3731,51 @@ encode_invocation_designation (charset, coding, dst) find all the necessary designations. */ static unsigned char * -encode_designation_at_bol (coding, translation_table, src, src_end, dst) +encode_designation_at_bol (coding, charbuf, charbuf_end, dst) struct coding_system *coding; - Lisp_Object translation_table; - const unsigned char *src, *src_end; + int *charbuf, *charbuf_end; unsigned char *dst; { - int charset, c, found = 0, reg; + struct charset *charset; /* Table of charsets to be designated to each graphic register. */ int r[4]; + int c, found = 0, reg; + int produced_chars = 0; + int multibytep = coding->dst_multibyte; + Lisp_Object attrs; + Lisp_Object charset_list; + + attrs = CODING_ID_ATTRS (coding->id); + charset_list = CODING_ATTR_CHARSET_LIST (attrs); + if (EQ (charset_list, Qiso_2022)) + charset_list = Viso_2022_charset_list; for (reg = 0; reg < 4; reg++) r[reg] = -1; while (found < 4) { - ONE_MORE_CHAR (c); + int id; + + c = *charbuf++; if (c == '\n') break; - - charset = CHAR_CHARSET (c); - reg = CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset); - if (reg != CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION && r[reg] < 0) + charset = char_charset (c, charset_list, NULL); + id = CHARSET_ID (charset); + reg = CODING_ISO_REQUEST (coding, id); + if (reg >= 0 && r[reg] < 0) { found++; - r[reg] = charset; + r[reg] = id; } } - label_end_of_loop: if (found) { for (reg = 0; reg < 4; reg++) if (r[reg] >= 0 - && CODING_SPEC_ISO_DESIGNATION (coding, reg) != r[reg]) - ENCODE_DESIGNATION (r[reg], reg, coding); + && CODING_ISO_DESIGNATION (coding, reg) != r[reg]) + ENCODE_DESIGNATION (CHARSET_FROM_ID (r[reg]), reg, coding); } return dst; @@ -2649,188 +3783,160 @@ encode_designation_at_bol (coding, translation_table, src, src_end, dst) /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". */ -static void -encode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) +static int +encode_coding_iso_2022 (coding) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; { - const unsigned char *src = source; - const unsigned char *src_end = source + src_bytes; - unsigned char *dst = destination; - unsigned char *dst_end = destination + dst_bytes; - /* Since the maximum bytes produced by each loop is 20, we subtract 19 - from DST_END to assure overflow checking is necessary only at the - head of loop. */ - unsigned char *adjusted_dst_end = dst_end - 19; - /* SRC_BASE remembers the start position in source in each loop. - The loop will be exited when there's not enough source text to - analyze multi-byte codes (within macro ONE_MORE_CHAR), or when - there's not enough destination area to produce encoded codes - (within macro EMIT_BYTES). */ - const unsigned char *src_base; + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int safe_room = 16; + int bol_designation + = (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL + && CODING_ISO_BOL (coding)); + int produced_chars = 0; + Lisp_Object attrs, eol_type, charset_list; + int ascii_compatible; int c; - Lisp_Object translation_table; - Lisp_Object safe_chars; + int preferred_charset_id = -1; - if (coding->flags & CODING_FLAG_ISO_SAFE) - coding->mode |= CODING_MODE_INHIBIT_UNENCODABLE_CHAR; + CODING_GET_INFO (coding, attrs, charset_list); + eol_type = CODING_ID_EOL_TYPE (coding->id); + if (VECTORP (eol_type)) + eol_type = Qunix; - safe_chars = coding_safe_chars (coding->symbol); + setup_iso_safe_charsets (attrs); + /* Charset list may have been changed. */ + charset_list = CODING_ATTR_CHARSET_LIST (attrs); + coding->safe_charsets = (char *) SDATA (CODING_ATTR_SAFE_CHARSETS(attrs)); - if (NILP (Venable_character_translation)) - translation_table = Qnil; - else - { - translation_table = coding->translation_table_for_encode; - if (NILP (translation_table)) - translation_table = Vstandard_translation_table_for_encode; - } + ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); - coding->consumed_char = 0; - coding->errors = 0; - while (1) + while (charbuf < charbuf_end) { - src_base = src; + ASSURE_DESTINATION (safe_room); - if (dst >= (dst_bytes ? adjusted_dst_end : (src - 19))) + if (bol_designation) { - coding->result = CODING_FINISH_INSUFFICIENT_DST; - break; - } + unsigned char *dst_prev = dst; - if (coding->flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL - && CODING_SPEC_ISO_BOL (coding)) - { /* We have to produce designation sequences if any now. */ - dst = encode_designation_at_bol (coding, translation_table, - src, src_end, dst); - CODING_SPEC_ISO_BOL (coding) = 0; + dst = encode_designation_at_bol (coding, charbuf, charbuf_end, dst); + bol_designation = 0; + /* We are sure that designation sequences are all ASCII bytes. */ + produced_chars += dst - dst_prev; } - /* Check composition start and end. */ - if (coding->composing != COMPOSITION_DISABLED - && coding->cmp_data_start < coding->cmp_data->used) - { - struct composition_data *cmp_data = coding->cmp_data; - int *data = cmp_data->data + coding->cmp_data_start; - int this_pos = cmp_data->char_offset + coding->consumed_char; + c = *charbuf++; - if (coding->composing == COMPOSITION_RELATIVE) - { - if (this_pos == data[2]) - { - ENCODE_COMPOSITION_END (coding, data); - cmp_data = coding->cmp_data; - data = cmp_data->data + coding->cmp_data_start; - } - } - else if (COMPOSING_P (coding)) - { - /* COMPOSITION_WITH_ALTCHARS or COMPOSITION_WITH_RULE_ALTCHAR */ - if (coding->cmp_data_index == coding->cmp_data_start + data[0]) - /* We have consumed components of the composition. - What follows in SRC is the composition's base - text. */ - ENCODE_COMPOSITION_FAKE_START (coding); - else - { - int c = cmp_data->data[coding->cmp_data_index++]; - if (coding->composition_rule_follows) - { - ENCODE_COMPOSITION_RULE (c); - coding->composition_rule_follows = 0; - } - else - { - if (coding->mode & CODING_MODE_INHIBIT_UNENCODABLE_CHAR - && ! CODING_SAFE_CHAR_P (safe_chars, c)) - ENCODE_UNSAFE_CHARACTER (c); - else - ENCODE_ISO_CHARACTER (c); - if (coding->composing == COMPOSITION_WITH_RULE_ALTCHARS) - coding->composition_rule_follows = 1; - } - continue; - } - } - if (!COMPOSING_P (coding)) + if (c < 0) + { + /* Handle an annotation. */ + switch (*charbuf) { - if (this_pos == data[1]) - { - ENCODE_COMPOSITION_START (coding, data); - continue; - } + case CODING_ANNOTATE_COMPOSITION_MASK: + /* Not yet implemented. */ + break; + case CODING_ANNOTATE_CHARSET_MASK: + preferred_charset_id = charbuf[2]; + if (preferred_charset_id >= 0 + && NILP (Fmemq (make_number (preferred_charset_id), + charset_list))) + preferred_charset_id = -1; + break; + default: + abort (); } + charbuf += -c - 1; + continue; } - ONE_MORE_CHAR (c); - /* Now encode the character C. */ if (c < 0x20 || c == 0x7F) { - if (c == '\r') + if (c == '\n' + || (c == '\r' && EQ (eol_type, Qmac))) { - if (! (coding->mode & CODING_MODE_SELECTIVE_DISPLAY)) + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_EOL) + ENCODE_RESET_PLANE_AND_REGISTER (); + if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_INIT_AT_BOL) { - if (coding->flags & CODING_FLAG_ISO_RESET_AT_CNTL) - ENCODE_RESET_PLANE_AND_REGISTER; - *dst++ = c; - continue; + int i; + + for (i = 0; i < 4; i++) + CODING_ISO_DESIGNATION (coding, i) + = CODING_ISO_INITIAL (coding, i); } - /* fall down to treat '\r' as '\n' ... */ - c = '\n'; - } - if (c == '\n') - { - if (coding->flags & CODING_FLAG_ISO_RESET_AT_EOL) - ENCODE_RESET_PLANE_AND_REGISTER; - if (coding->flags & CODING_FLAG_ISO_INIT_AT_BOL) - bcopy (coding->spec.iso2022.initial_designation, - coding->spec.iso2022.current_designation, - sizeof coding->spec.iso2022.initial_designation); - if (coding->eol_type == CODING_EOL_LF - || coding->eol_type == CODING_EOL_UNDECIDED) - *dst++ = ISO_CODE_LF; - else if (coding->eol_type == CODING_EOL_CRLF) - *dst++ = ISO_CODE_CR, *dst++ = ISO_CODE_LF; - else - *dst++ = ISO_CODE_CR; - CODING_SPEC_ISO_BOL (coding) = 1; + bol_designation + = CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL; } + else if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_CNTL) + ENCODE_RESET_PLANE_AND_REGISTER (); + EMIT_ONE_ASCII_BYTE (c); + } + else if (ASCII_CHAR_P (c)) + { + if (ascii_compatible) + EMIT_ONE_ASCII_BYTE (c); else { - if (coding->flags & CODING_FLAG_ISO_RESET_AT_CNTL) - ENCODE_RESET_PLANE_AND_REGISTER; - *dst++ = c; + struct charset *charset = CHARSET_FROM_ID (charset_ascii); + ENCODE_ISO_CHARACTER (charset, c); } } - else if (ASCII_BYTE_P (c)) - ENCODE_ISO_CHARACTER (c); - else if (SINGLE_BYTE_CHAR_P (c)) + else if (CHAR_BYTE8_P (c)) { - *dst++ = c; - coding->errors++; + c = CHAR_TO_BYTE8 (c); + EMIT_ONE_BYTE (c); } - else if (coding->mode & CODING_MODE_INHIBIT_UNENCODABLE_CHAR - && ! CODING_SAFE_CHAR_P (safe_chars, c)) - ENCODE_UNSAFE_CHARACTER (c); else - ENCODE_ISO_CHARACTER (c); + { + struct charset *charset; - coding->consumed_char++; + if (preferred_charset_id >= 0) + { + charset = CHARSET_FROM_ID (preferred_charset_id); + if (! CHAR_CHARSET_P (c, charset)) + charset = char_charset (c, charset_list, NULL); + } + else + charset = char_charset (c, charset_list, NULL); + if (!charset) + { + if (coding->mode & CODING_MODE_SAFE_ENCODING) + { + c = CODING_INHIBIT_CHARACTER_SUBSTITUTION; + charset = CHARSET_FROM_ID (charset_ascii); + } + else + { + c = coding->default_char; + charset = char_charset (c, charset_list, NULL); + } + } + ENCODE_ISO_CHARACTER (charset, c); + } } - label_end_of_loop: - coding->consumed = src_base - source; - coding->produced = coding->produced_char = dst - destination; + if (coding->mode & CODING_MODE_LAST_BLOCK + && CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_EOL) + { + ASSURE_DESTINATION (safe_room); + ENCODE_RESET_PLANE_AND_REGISTER (); + } + record_conversion_result (coding, CODING_RESULT_SUCCESS); + CODING_ISO_BOL (coding) = bol_designation; + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; + return 0; } -/*** 4. SJIS and BIG5 handlers ***/ +/*** 8,9. SJIS and BIG5 handlers ***/ -/* Although SJIS and BIG5 are not ISO coding systems, they are used +/* Although SJIS and BIG5 are not ISO's coding system, they are used quite widely. So, for the moment, Emacs supports them in the bare C code. But, in the future, they may be supported only by CCL. */ @@ -2839,12 +3945,12 @@ encode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) as is. A character of charset katakana-jisx0201 is encoded by "position-code + 0x80". A character of charset japanese-jisx0208 is encoded in 2-byte but two position-codes are divided and shifted - so that it fits in the range below. + so that it fit in the range below. --- CODE RANGE of SJIS --- (character set) (range) ASCII 0x00 .. 0x7F - KATAKANA-JISX0201 0xA1 .. 0xDF + KATAKANA-JISX0201 0xA0 .. 0xDF JISX0208 (1st byte) 0x81 .. 0x9F and 0xE0 .. 0xEF (2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC ------------------------------- @@ -2853,7 +3959,7 @@ encode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) /* BIG5 is a coding system encoding two character sets: ASCII and Big5. An ASCII character is encoded as is. Big5 is a two-byte - character set and is encoded in two bytes. + character set and is encoded in two-byte. --- CODE RANGE of BIG5 --- (character set) (range) @@ -2862,307 +3968,293 @@ encode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes) (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE -------------------------- - Since the number of characters in Big5 is larger than maximum - characters in Emacs' charset (96x96), it can't be handled as one - charset. So, in Emacs, Big5 is divided into two: `charset-big5-1' - and `charset-big5-2'. Both are DIMENSION2 and CHARS94. The former - contains frequently used characters and the latter contains less - frequently used characters. */ - -/* Macros to decode or encode a character of Big5 in BIG5. B1 and B2 - are the 1st and 2nd position-codes of Big5 in BIG5 coding system. - C1 and C2 are the 1st and 2nd position-codes of Emacs' internal - format. CHARSET is `charset_big5_1' or `charset_big5_2'. */ - -/* Number of Big5 characters which have the same code in 1st byte. */ -#define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40) - -#define DECODE_BIG5(b1, b2, charset, c1, c2) \ - do { \ - unsigned int temp \ - = (b1 - 0xA1) * BIG5_SAME_ROW + b2 - (b2 < 0x7F ? 0x40 : 0x62); \ - if (b1 < 0xC9) \ - charset = charset_big5_1; \ - else \ - { \ - charset = charset_big5_2; \ - temp -= (0xC9 - 0xA1) * BIG5_SAME_ROW; \ - } \ - c1 = temp / (0xFF - 0xA1) + 0x21; \ - c2 = temp % (0xFF - 0xA1) + 0x21; \ - } while (0) - -#define ENCODE_BIG5(charset, c1, c2, b1, b2) \ - do { \ - unsigned int temp = (c1 - 0x21) * (0xFF - 0xA1) + (c2 - 0x21); \ - if (charset == charset_big5_2) \ - temp += BIG5_SAME_ROW * (0xC9 - 0xA1); \ - b1 = temp / BIG5_SAME_ROW + 0xA1; \ - b2 = temp % BIG5_SAME_ROW; \ - b2 += b2 < 0x3F ? 0x40 : 0x62; \ - } while (0) + */ /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". Check if a text is encoded in SJIS. If it is, return - CODING_CATEGORY_MASK_SJIS, else return 0. */ + CATEGORY_MASK_SJIS, else return 0. */ static int -detect_coding_sjis (src, src_end, multibytep) - unsigned char *src, *src_end; - int multibytep; +detect_coding_sjis (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; { + const unsigned char *src = coding->source, *src_base; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int consumed_chars = 0; + int found = 0; int c; - /* Dummy for ONE_MORE_BYTE. */ - struct coding_system dummy_coding; - struct coding_system *coding = &dummy_coding; + + detect_info->checked |= CATEGORY_MASK_SJIS; + /* A coding system of this category is always ASCII compatible. */ + src += coding->head_ascii; while (1) { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, CODING_CATEGORY_MASK_SJIS); + src_base = src; + ONE_MORE_BYTE (c); if (c < 0x80) continue; - if (c == 0x80 || c == 0xA0 || c > 0xEF) - return 0; - if (c <= 0x9F || c >= 0xE0) + if ((c >= 0x81 && c <= 0x9F) || (c >= 0xE0 && c <= 0xEF)) { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, 0); + ONE_MORE_BYTE (c); if (c < 0x40 || c == 0x7F || c > 0xFC) - return 0; + break; + found = CATEGORY_MASK_SJIS; } + else if (c >= 0xA0 && c < 0xE0) + found = CATEGORY_MASK_SJIS; + else + break; + } + detect_info->rejected |= CATEGORY_MASK_SJIS; + return 0; + + no_more_source: + if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK) + { + detect_info->rejected |= CATEGORY_MASK_SJIS; + return 0; } + detect_info->found |= found; + return 1; } /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". Check if a text is encoded in BIG5. If it is, return - CODING_CATEGORY_MASK_BIG5, else return 0. */ + CATEGORY_MASK_BIG5, else return 0. */ static int -detect_coding_big5 (src, src_end, multibytep) - unsigned char *src, *src_end; - int multibytep; +detect_coding_big5 (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; { + const unsigned char *src = coding->source, *src_base; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int consumed_chars = 0; + int found = 0; int c; - /* Dummy for ONE_MORE_BYTE. */ - struct coding_system dummy_coding; - struct coding_system *coding = &dummy_coding; + + detect_info->checked |= CATEGORY_MASK_BIG5; + /* A coding system of this category is always ASCII compatible. */ + src += coding->head_ascii; while (1) { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, CODING_CATEGORY_MASK_BIG5); + src_base = src; + ONE_MORE_BYTE (c); if (c < 0x80) continue; - if (c < 0xA1 || c > 0xFE) - return 0; - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, 0); - if (c < 0x40 || (c > 0x7F && c < 0xA1) || c > 0xFE) - return 0; + if (c >= 0xA1) + { + ONE_MORE_BYTE (c); + if (c < 0x40 || (c >= 0x7F && c <= 0xA0)) + return 0; + found = CATEGORY_MASK_BIG5; + } + else + break; } -} + detect_info->rejected |= CATEGORY_MASK_BIG5; + return 0; -/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". - Check if a text is encoded in UTF-8. If it is, return - CODING_CATEGORY_MASK_UTF_8, else return 0. */ + no_more_source: + if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK) + { + detect_info->rejected |= CATEGORY_MASK_BIG5; + return 0; + } + detect_info->found |= found; + return 1; +} -#define UTF_8_1_OCTET_P(c) ((c) < 0x80) -#define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80) -#define UTF_8_2_OCTET_LEADING_P(c) (((c) & 0xE0) == 0xC0) -#define UTF_8_3_OCTET_LEADING_P(c) (((c) & 0xF0) == 0xE0) -#define UTF_8_4_OCTET_LEADING_P(c) (((c) & 0xF8) == 0xF0) -#define UTF_8_5_OCTET_LEADING_P(c) (((c) & 0xFC) == 0xF8) -#define UTF_8_6_OCTET_LEADING_P(c) (((c) & 0xFE) == 0xFC) +/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". + If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */ -static int -detect_coding_utf_8 (src, src_end, multibytep) - unsigned char *src, *src_end; - int multibytep; +static void +decode_coding_sjis (coding) + struct coding_system *coding; { - unsigned char c; - int seq_maybe_bytes; - /* Dummy for ONE_MORE_BYTE. */ - struct coding_system dummy_coding; - struct coding_system *coding = &dummy_coding; + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; + const unsigned char *src_base; + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end + = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH; + int consumed_chars = 0, consumed_chars_base; + int multibytep = coding->src_multibyte; + struct charset *charset_roman, *charset_kanji, *charset_kana; + struct charset *charset_kanji2; + Lisp_Object attrs, charset_list, val; + int char_offset = coding->produced_char; + int last_offset = char_offset; + int last_id = charset_ascii; + + CODING_GET_INFO (coding, attrs, charset_list); + + val = charset_list; + charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val))); while (1) { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, CODING_CATEGORY_MASK_UTF_8); - if (UTF_8_1_OCTET_P (c)) - continue; - else if (UTF_8_2_OCTET_LEADING_P (c)) - seq_maybe_bytes = 1; - else if (UTF_8_3_OCTET_LEADING_P (c)) - seq_maybe_bytes = 2; - else if (UTF_8_4_OCTET_LEADING_P (c)) - seq_maybe_bytes = 3; - else if (UTF_8_5_OCTET_LEADING_P (c)) - seq_maybe_bytes = 4; - else if (UTF_8_6_OCTET_LEADING_P (c)) - seq_maybe_bytes = 5; - else - return 0; + int c, c1; + struct charset *charset; - do - { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, 0); - if (!UTF_8_EXTRA_OCTET_P (c)) - return 0; - seq_maybe_bytes--; - } - while (seq_maybe_bytes > 0); - } -} - -/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". - Check if a text is encoded in UTF-16 Big Endian (endian == 1) or - Little Endian (otherwise). If it is, return - CODING_CATEGORY_MASK_UTF_16_BE or CODING_CATEGORY_MASK_UTF_16_LE, - else return 0. */ - -#define UTF_16_INVALID_P(val) \ - (((val) == 0xFFFE) \ - || ((val) == 0xFFFF)) - -#define UTF_16_HIGH_SURROGATE_P(val) \ - (((val) & 0xD800) == 0xD800) + src_base = src; + consumed_chars_base = consumed_chars; -#define UTF_16_LOW_SURROGATE_P(val) \ - (((val) & 0xDC00) == 0xDC00) + if (charbuf >= charbuf_end) + break; -static int -detect_coding_utf_16 (src, src_end, multibytep) - unsigned char *src, *src_end; - int multibytep; -{ - unsigned char c1, c2; - /* Dummy for ONE_MORE_BYTE_CHECK_MULTIBYTE. */ - struct coding_system dummy_coding; - struct coding_system *coding = &dummy_coding; + ONE_MORE_BYTE (c); + if (c < 0) + goto invalid_code; + if (c < 0x80) + charset = charset_roman; + else if (c == 0x80 || c == 0xA0) + goto invalid_code; + else if (c >= 0xA1 && c <= 0xDF) + { + /* SJIS -> JISX0201-Kana */ + c &= 0x7F; + charset = charset_kana; + } + else if (c <= 0xEF) + { + /* SJIS -> JISX0208 */ + ONE_MORE_BYTE (c1); + if (c1 < 0x40 || c1 == 0x7F || c1 > 0xFC) + goto invalid_code; + c = (c << 8) | c1; + SJIS_TO_JIS (c); + charset = charset_kanji; + } + else if (c <= 0xFC && charset_kanji2) + { + /* SJIS -> JISX0213-2 */ + ONE_MORE_BYTE (c1); + if (c1 < 0x40 || c1 == 0x7F || c1 > 0xFC) + goto invalid_code; + c = (c << 8) | c1; + SJIS_TO_JIS2 (c); + charset = charset_kanji2; + } + else + goto invalid_code; + if (charset->id != charset_ascii + && last_id != charset->id) + { + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + last_id = charset->id; + last_offset = char_offset; + } + CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c); + *charbuf++ = c; + char_offset++; + continue; - ONE_MORE_BYTE_CHECK_MULTIBYTE (c1, multibytep, 0); - ONE_MORE_BYTE_CHECK_MULTIBYTE (c2, multibytep, 0); + invalid_code: + src = src_base; + consumed_chars = consumed_chars_base; + ONE_MORE_BYTE (c); + *charbuf++ = c < 0 ? -c : BYTE8_TO_CHAR (c); + char_offset++; + coding->errors++; + } - if ((c1 == 0xFF) && (c2 == 0xFE)) - return CODING_CATEGORY_MASK_UTF_16_LE; - else if ((c1 == 0xFE) && (c2 == 0xFF)) - return CODING_CATEGORY_MASK_UTF_16_BE; - return 0; + no_more_source: + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + coding->consumed_char += consumed_chars_base; + coding->consumed = src_base - coding->source; + coding->charbuf_used = charbuf - coding->charbuf; } -/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". - If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */ - static void -decode_coding_sjis_big5 (coding, source, destination, - src_bytes, dst_bytes, sjis_p) +decode_coding_big5 (coding) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; - int sjis_p; { - const unsigned char *src = source; - const unsigned char *src_end = source + src_bytes; - unsigned char *dst = destination; - unsigned char *dst_end = destination + dst_bytes; - /* SRC_BASE remembers the start position in source in each loop. - The loop will be exited when there's not enough source code - (within macro ONE_MORE_BYTE), or when there's not enough - destination area to produce a character (within macro - EMIT_CHAR). */ + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; const unsigned char *src_base; - Lisp_Object translation_table; - - if (NILP (Venable_character_translation)) - translation_table = Qnil; - else - { - translation_table = coding->translation_table_for_decode; - if (NILP (translation_table)) - translation_table = Vstandard_translation_table_for_decode; - } + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end + = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH; + int consumed_chars = 0, consumed_chars_base; + int multibytep = coding->src_multibyte; + struct charset *charset_roman, *charset_big5; + Lisp_Object attrs, charset_list, val; + int char_offset = coding->produced_char; + int last_offset = char_offset; + int last_id = charset_ascii; + + CODING_GET_INFO (coding, attrs, charset_list); + val = charset_list; + charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val))); - coding->produced_char = 0; while (1) { - int c, charset, c1, c2 = 0; + int c, c1; + struct charset *charset; src_base = src; - ONE_MORE_BYTE (c1); + consumed_chars_base = consumed_chars; - if (c1 < 0x80) + if (charbuf >= charbuf_end) + break; + + ONE_MORE_BYTE (c); + + if (c < 0) + goto invalid_code; + if (c < 0x80) + charset = charset_roman; + else { - charset = CHARSET_ASCII; - if (c1 < 0x20) - { - if (c1 == '\r') - { - if (coding->eol_type == CODING_EOL_CRLF) - { - ONE_MORE_BYTE (c2); - if (c2 == '\n') - c1 = c2; - else - /* To process C2 again, SRC is subtracted by 1. */ - src--; - } - else if (coding->eol_type == CODING_EOL_CR) - c1 = '\n'; - } - else if (c1 == '\n' - && (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL) - && (coding->eol_type == CODING_EOL_CR - || coding->eol_type == CODING_EOL_CRLF)) - { - coding->result = CODING_FINISH_INCONSISTENT_EOL; - goto label_end_of_loop; - } - } + /* BIG5 -> Big5 */ + if (c < 0xA1 || c > 0xFE) + goto invalid_code; + ONE_MORE_BYTE (c1); + if (c1 < 0x40 || (c1 > 0x7E && c1 < 0xA1) || c1 > 0xFE) + goto invalid_code; + c = c << 8 | c1; + charset = charset_big5; } - else - { - if (sjis_p) - { - if (c1 == 0x80 || c1 == 0xA0 || c1 > 0xEF) - goto label_invalid_code; - if (c1 <= 0x9F || c1 >= 0xE0) - { - /* SJIS -> JISX0208 */ - ONE_MORE_BYTE (c2); - if (c2 < 0x40 || c2 == 0x7F || c2 > 0xFC) - goto label_invalid_code; - DECODE_SJIS (c1, c2, c1, c2); - charset = charset_jisx0208; - } - else - /* SJIS -> JISX0201-Kana */ - charset = charset_katakana_jisx0201; - } - else - { - /* BIG5 -> Big5 */ - if (c1 < 0xA0 || c1 > 0xFE) - goto label_invalid_code; - ONE_MORE_BYTE (c2); - if (c2 < 0x40 || (c2 > 0x7E && c2 < 0xA1) || c2 > 0xFE) - goto label_invalid_code; - DECODE_BIG5 (c1, c2, charset, c1, c2); - } + if (charset->id != charset_ascii + && last_id != charset->id) + { + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + last_id = charset->id; + last_offset = char_offset; } - - c = DECODE_ISO_CHARACTER (charset, c1, c2); - EMIT_CHAR (c); + CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c); + *charbuf++ = c; + char_offset++; continue; - label_invalid_code: - coding->errors++; + invalid_code: src = src_base; - c = *src++; - EMIT_CHAR (c); + consumed_chars = consumed_chars_base; + ONE_MORE_BYTE (c); + *charbuf++ = c < 0 ? -c : BYTE8_TO_CHAR (c); + char_offset++; + coding->errors++; } - label_end_of_loop: - coding->consumed = coding->consumed_char = src_base - source; - coding->produced = dst - destination; - return; + no_more_source: + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + coding->consumed_char += consumed_chars_base; + coding->consumed = src_base - coding->source; + coding->charbuf_used = charbuf - coding->charbuf; } /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". @@ -3173,825 +4265,1013 @@ decode_coding_sjis_big5 (coding, source, destination, charsets are produced without any encoding. If SJIS_P is 1, encode SJIS text, else encode BIG5 text. */ -static void -encode_coding_sjis_big5 (coding, source, destination, - src_bytes, dst_bytes, sjis_p) +static int +encode_coding_sjis (coding) struct coding_system *coding; - unsigned char *source, *destination; - int src_bytes, dst_bytes; - int sjis_p; { - unsigned char *src = source; - unsigned char *src_end = source + src_bytes; - unsigned char *dst = destination; - unsigned char *dst_end = destination + dst_bytes; - /* SRC_BASE remembers the start position in source in each loop. - The loop will be exited when there's not enough source text to - analyze multi-byte codes (within macro ONE_MORE_CHAR), or when - there's not enough destination area to produce encoded codes - (within macro EMIT_BYTES). */ - unsigned char *src_base; - Lisp_Object translation_table; - - if (NILP (Venable_character_translation)) - translation_table = Qnil; - else - { - translation_table = coding->translation_table_for_encode; - if (NILP (translation_table)) - translation_table = Vstandard_translation_table_for_encode; - } + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int safe_room = 4; + int produced_chars = 0; + Lisp_Object attrs, charset_list, val; + int ascii_compatible; + struct charset *charset_roman, *charset_kanji, *charset_kana; + struct charset *charset_kanji2; + int c; - while (1) - { - int c, charset, c1, c2; + CODING_GET_INFO (coding, attrs, charset_list); + val = charset_list; + charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val))); - src_base = src; - ONE_MORE_CHAR (c); + ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); + while (charbuf < charbuf_end) + { + ASSURE_DESTINATION (safe_room); + c = *charbuf++; /* Now encode the character C. */ - if (SINGLE_BYTE_CHAR_P (c)) + if (ASCII_CHAR_P (c) && ascii_compatible) + EMIT_ONE_ASCII_BYTE (c); + else if (CHAR_BYTE8_P (c)) + { + c = CHAR_TO_BYTE8 (c); + EMIT_ONE_BYTE (c); + } + else { - switch (c) + unsigned code; + struct charset *charset = char_charset (c, charset_list, &code); + + if (!charset) { - case '\r': - if (!(coding->mode & CODING_MODE_SELECTIVE_DISPLAY)) + if (coding->mode & CODING_MODE_SAFE_ENCODING) { - EMIT_ONE_BYTE (c); - break; + code = CODING_INHIBIT_CHARACTER_SUBSTITUTION; + charset = CHARSET_FROM_ID (charset_ascii); } - c = '\n'; - case '\n': - if (coding->eol_type == CODING_EOL_CRLF) + else { - EMIT_TWO_BYTES ('\r', c); - break; + c = coding->default_char; + charset = char_charset (c, charset_list, &code); } - else if (coding->eol_type == CODING_EOL_CR) - c = '\r'; - default: - EMIT_ONE_BYTE (c); } - } - else - { - SPLIT_CHAR (c, charset, c1, c2); - if (sjis_p) + if (code == CHARSET_INVALID_CODE (charset)) + abort (); + if (charset == charset_kanji) { - if (charset == charset_jisx0208 - || charset == charset_jisx0208_1978) + int c1, c2; + JIS_TO_SJIS (code); + c1 = code >> 8, c2 = code & 0xFF; + EMIT_TWO_BYTES (c1, c2); + } + else if (charset == charset_kana) + EMIT_ONE_BYTE (code | 0x80); + else if (charset_kanji2 && charset == charset_kanji2) + { + int c1, c2; + + c1 = code >> 8; + if (c1 == 0x21 || (c1 >= 0x23 && c1 < 0x25) + || (c1 >= 0x2C && c1 <= 0x2F) || c1 >= 0x6E) { - ENCODE_SJIS (c1, c2, c1, c2); + JIS_TO_SJIS2 (code); + c1 = code >> 8, c2 = code & 0xFF; EMIT_TWO_BYTES (c1, c2); } - else if (charset == charset_katakana_jisx0201) - EMIT_ONE_BYTE (c1 | 0x80); - else if (charset == charset_latin_jisx0201) - EMIT_ONE_BYTE (c1); - else if (coding->mode & CODING_MODE_INHIBIT_UNENCODABLE_CHAR) - { - EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER); - if (CHARSET_WIDTH (charset) > 1) - EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER); - } else - /* There's no way other than producing the internal - codes as is. */ - EMIT_BYTES (src_base, src); + EMIT_ONE_ASCII_BYTE (code & 0x7F); } else + EMIT_ONE_ASCII_BYTE (code & 0x7F); + } + } + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; + return 0; +} + +static int +encode_coding_big5 (coding) + struct coding_system *coding; +{ + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int safe_room = 4; + int produced_chars = 0; + Lisp_Object attrs, charset_list, val; + int ascii_compatible; + struct charset *charset_roman, *charset_big5; + int c; + + CODING_GET_INFO (coding, attrs, charset_list); + val = charset_list; + charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val))); + ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); + + while (charbuf < charbuf_end) + { + ASSURE_DESTINATION (safe_room); + c = *charbuf++; + /* Now encode the character C. */ + if (ASCII_CHAR_P (c) && ascii_compatible) + EMIT_ONE_ASCII_BYTE (c); + else if (CHAR_BYTE8_P (c)) + { + c = CHAR_TO_BYTE8 (c); + EMIT_ONE_BYTE (c); + } + else + { + unsigned code; + struct charset *charset = char_charset (c, charset_list, &code); + + if (! charset) { - if (charset == charset_big5_1 || charset == charset_big5_2) + if (coding->mode & CODING_MODE_SAFE_ENCODING) { - ENCODE_BIG5 (charset, c1, c2, c1, c2); - EMIT_TWO_BYTES (c1, c2); + code = CODING_INHIBIT_CHARACTER_SUBSTITUTION; + charset = CHARSET_FROM_ID (charset_ascii); } - else if (coding->mode & CODING_MODE_INHIBIT_UNENCODABLE_CHAR) + else { - EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER); - if (CHARSET_WIDTH (charset) > 1) - EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER); + c = coding->default_char; + charset = char_charset (c, charset_list, &code); } - else - /* There's no way other than producing the internal - codes as is. */ - EMIT_BYTES (src_base, src); } + if (code == CHARSET_INVALID_CODE (charset)) + abort (); + if (charset == charset_big5) + { + int c1, c2; + + c1 = code >> 8, c2 = code & 0xFF; + EMIT_TWO_BYTES (c1, c2); + } + else + EMIT_ONE_ASCII_BYTE (code & 0x7F); } - coding->consumed_char++; } - - label_end_of_loop: - coding->consumed = src_base - source; - coding->produced = coding->produced_char = dst - destination; + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; + return 0; } -/*** 5. CCL handlers ***/ +/*** 10. CCL handlers ***/ /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". Check if a text is encoded in a coding system of which encoder/decoder are written in CCL program. If it is, return - CODING_CATEGORY_MASK_CCL, else return 0. */ + CATEGORY_MASK_CCL, else return 0. */ static int -detect_coding_ccl (src, src_end, multibytep) - unsigned char *src, *src_end; - int multibytep; +detect_coding_ccl (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; { - unsigned char *valid; - int c; - /* Dummy for ONE_MORE_BYTE. */ - struct coding_system dummy_coding; - struct coding_system *coding = &dummy_coding; - - /* No coding system is assigned to coding-category-ccl. */ - if (!coding_system_table[CODING_CATEGORY_IDX_CCL]) - return 0; + const unsigned char *src = coding->source, *src_base; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int consumed_chars = 0; + int found = 0; + unsigned char *valids; + int head_ascii = coding->head_ascii; + Lisp_Object attrs; + + detect_info->checked |= CATEGORY_MASK_CCL; + + coding = &coding_categories[coding_category_ccl]; + valids = CODING_CCL_VALIDS (coding); + attrs = CODING_ID_ATTRS (coding->id); + if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs))) + src += head_ascii; - valid = coding_system_table[CODING_CATEGORY_IDX_CCL]->spec.ccl.valid_codes; while (1) { - ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, CODING_CATEGORY_MASK_CCL); - if (! valid[c]) - return 0; + int c; + + src_base = src; + ONE_MORE_BYTE (c); + if (c < 0 || ! valids[c]) + break; + if ((valids[c] > 1)) + found = CATEGORY_MASK_CCL; } + detect_info->rejected |= CATEGORY_MASK_CCL; + return 0; + + no_more_source: + detect_info->found |= found; + return 1; } +static void +decode_coding_ccl (coding) + struct coding_system *coding; +{ + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end = coding->charbuf + coding->charbuf_size; + int consumed_chars = 0; + int multibytep = coding->src_multibyte; + struct ccl_program ccl; + int source_charbuf[1024]; + int source_byteidx[1024]; + Lisp_Object attrs, charset_list; + + CODING_GET_INFO (coding, attrs, charset_list); + setup_ccl_program (&ccl, CODING_CCL_DECODER (coding)); + + while (src < src_end) + { + const unsigned char *p = src; + int *source, *source_end; + int i = 0; + + if (multibytep) + while (i < 1024 && p < src_end) + { + source_byteidx[i] = p - src; + source_charbuf[i++] = STRING_CHAR_ADVANCE (p); + } + else + while (i < 1024 && p < src_end) + source_charbuf[i++] = *p++; + + if (p == src_end && coding->mode & CODING_MODE_LAST_BLOCK) + ccl.last_block = 1; + + source = source_charbuf; + source_end = source + i; + while (source < source_end) + { + ccl_driver (&ccl, source, charbuf, + source_end - source, charbuf_end - charbuf, + charset_list); + source += ccl.consumed; + charbuf += ccl.produced; + if (ccl.status != CCL_STAT_SUSPEND_BY_DST) + break; + } + if (source < source_end) + src += source_byteidx[source - source_charbuf]; + else + src = p; + consumed_chars += source - source_charbuf; + + if (ccl.status != CCL_STAT_SUSPEND_BY_SRC + && ccl.status != CODING_RESULT_INSUFFICIENT_SRC) + break; + } + + switch (ccl.status) + { + case CCL_STAT_SUSPEND_BY_SRC: + record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC); + break; + case CCL_STAT_SUSPEND_BY_DST: + break; + case CCL_STAT_QUIT: + case CCL_STAT_INVALID_CMD: + record_conversion_result (coding, CODING_RESULT_INTERRUPT); + break; + default: + record_conversion_result (coding, CODING_RESULT_SUCCESS); + break; + } + coding->consumed_char += consumed_chars; + coding->consumed = src - coding->source; + coding->charbuf_used = charbuf - coding->charbuf; +} + +static int +encode_coding_ccl (coding) + struct coding_system *coding; +{ + struct ccl_program ccl; + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int destination_charbuf[1024]; + int i, produced_chars = 0; + Lisp_Object attrs, charset_list; + + CODING_GET_INFO (coding, attrs, charset_list); + setup_ccl_program (&ccl, CODING_CCL_ENCODER (coding)); + + ccl.last_block = coding->mode & CODING_MODE_LAST_BLOCK; + ccl.dst_multibyte = coding->dst_multibyte; + + while (charbuf < charbuf_end) + { + ccl_driver (&ccl, charbuf, destination_charbuf, + charbuf_end - charbuf, 1024, charset_list); + if (multibytep) + { + ASSURE_DESTINATION (ccl.produced * 2); + for (i = 0; i < ccl.produced; i++) + EMIT_ONE_BYTE (destination_charbuf[i] & 0xFF); + } + else + { + ASSURE_DESTINATION (ccl.produced); + for (i = 0; i < ccl.produced; i++) + *dst++ = destination_charbuf[i] & 0xFF; + produced_chars += ccl.produced; + } + charbuf += ccl.consumed; + if (ccl.status == CCL_STAT_QUIT + || ccl.status == CCL_STAT_INVALID_CMD) + break; + } + + switch (ccl.status) + { + case CCL_STAT_SUSPEND_BY_SRC: + record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC); + break; + case CCL_STAT_SUSPEND_BY_DST: + record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_DST); + break; + case CCL_STAT_QUIT: + case CCL_STAT_INVALID_CMD: + record_conversion_result (coding, CODING_RESULT_INTERRUPT); + break; + default: + record_conversion_result (coding, CODING_RESULT_SUCCESS); + break; + } + + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; + return 0; +} + + -/*** 6. End-of-line handlers ***/ +/*** 10, 11. no-conversion handlers ***/ /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */ static void -decode_eol (coding, source, destination, src_bytes, dst_bytes) +decode_coding_raw_text (coding) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; { - const unsigned char *src = source; - unsigned char *dst = destination; - const unsigned char *src_end = src + src_bytes; - unsigned char *dst_end = dst + dst_bytes; - Lisp_Object translation_table; - /* SRC_BASE remembers the start position in source in each loop. - The loop will be exited when there's not enough source code - (within macro ONE_MORE_BYTE), or when there's not enough - destination area to produce a character (within macro - EMIT_CHAR). */ - const unsigned char *src_base; + coding->chars_at_source = 1; + coding->consumed_char = 0; + coding->consumed = 0; + record_conversion_result (coding, CODING_RESULT_SUCCESS); +} + +static int +encode_coding_raw_text (coding) + struct coding_system *coding; +{ + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = coding->charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int produced_chars = 0; int c; - translation_table = Qnil; - switch (coding->eol_type) + if (multibytep) { - case CODING_EOL_CRLF: - while (1) + int safe_room = MAX_MULTIBYTE_LENGTH * 2; + + if (coding->src_multibyte) + while (charbuf < charbuf_end) + { + ASSURE_DESTINATION (safe_room); + c = *charbuf++; + if (ASCII_CHAR_P (c)) + EMIT_ONE_ASCII_BYTE (c); + else if (CHAR_BYTE8_P (c)) + { + c = CHAR_TO_BYTE8 (c); + EMIT_ONE_BYTE (c); + } + else + { + unsigned char str[MAX_MULTIBYTE_LENGTH], *p0 = str, *p1 = str; + + CHAR_STRING_ADVANCE (c, p1); + while (p0 < p1) + { + EMIT_ONE_BYTE (*p0); + p0++; + } + } + } + else + while (charbuf < charbuf_end) + { + ASSURE_DESTINATION (safe_room); + c = *charbuf++; + EMIT_ONE_BYTE (c); + } + } + else + { + if (coding->src_multibyte) { - src_base = src; - ONE_MORE_BYTE (c); - if (c == '\r') + int safe_room = MAX_MULTIBYTE_LENGTH; + + while (charbuf < charbuf_end) { - ONE_MORE_BYTE (c); - if (c != '\n') - { - src--; - c = '\r'; - } + ASSURE_DESTINATION (safe_room); + c = *charbuf++; + if (ASCII_CHAR_P (c)) + *dst++ = c; + else if (CHAR_BYTE8_P (c)) + *dst++ = CHAR_TO_BYTE8 (c); + else + CHAR_STRING_ADVANCE (c, dst); + produced_chars++; } - else if (c == '\n' - && (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)) + } + else + { + ASSURE_DESTINATION (charbuf_end - charbuf); + while (charbuf < charbuf_end && dst < dst_end) + *dst++ = *charbuf++; + produced_chars = dst - (coding->destination + coding->dst_bytes); + } + } + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; + return 0; +} + +/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". + Check if a text is encoded in a charset-based coding system. If it + is, return 1, else return 0. */ + +static int +detect_coding_charset (coding, detect_info) + struct coding_system *coding; + struct coding_detection_info *detect_info; +{ + const unsigned char *src = coding->source, *src_base; + const unsigned char *src_end = coding->source + coding->src_bytes; + int multibytep = coding->src_multibyte; + int consumed_chars = 0; + Lisp_Object attrs, valids; + int found = 0; + int head_ascii = coding->head_ascii; + + detect_info->checked |= CATEGORY_MASK_CHARSET; + + coding = &coding_categories[coding_category_charset]; + attrs = CODING_ID_ATTRS (coding->id); + valids = AREF (attrs, coding_attr_charset_valids); + + if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs))) + src += head_ascii; + + while (1) + { + int c; + Lisp_Object val; + struct charset *charset; + int dim, idx; + + src_base = src; + ONE_MORE_BYTE (c); + if (c < 0) + continue; + val = AREF (valids, c); + if (NILP (val)) + break; + if (c >= 0x80) + found = CATEGORY_MASK_CHARSET; + if (INTEGERP (val)) + { + charset = CHARSET_FROM_ID (XFASTINT (val)); + dim = CHARSET_DIMENSION (charset); + for (idx = 1; idx < dim; idx++) { - coding->result = CODING_FINISH_INCONSISTENT_EOL; - goto label_end_of_loop; + if (src == src_end) + goto too_short; + ONE_MORE_BYTE (c); + if (c < charset->code_space[(dim - 1 - idx) * 2] + || c > charset->code_space[(dim - 1 - idx) * 2 + 1]) + break; } - EMIT_CHAR (c); + if (idx < dim) + break; } - break; - - case CODING_EOL_CR: - while (1) + else { - src_base = src; - ONE_MORE_BYTE (c); - if (c == '\n') + idx = 1; + for (; CONSP (val); val = XCDR (val)) { - if (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL) + charset = CHARSET_FROM_ID (XFASTINT (XCAR (val))); + dim = CHARSET_DIMENSION (charset); + while (idx < dim) + { + if (src == src_end) + goto too_short; + ONE_MORE_BYTE (c); + if (c < charset->code_space[(dim - 1 - idx) * 4] + || c > charset->code_space[(dim - 1 - idx) * 4 + 1]) + break; + idx++; + } + if (idx == dim) { - coding->result = CODING_FINISH_INCONSISTENT_EOL; - goto label_end_of_loop; + val = Qnil; + break; } } - else if (c == '\r') - c = '\n'; - EMIT_CHAR (c); - } - break; - - default: /* no need for EOL handling */ - while (1) - { - src_base = src; - ONE_MORE_BYTE (c); - EMIT_CHAR (c); + if (CONSP (val)) + break; } } + too_short: + detect_info->rejected |= CATEGORY_MASK_CHARSET; + return 0; - label_end_of_loop: - coding->consumed = coding->consumed_char = src_base - source; - coding->produced = dst - destination; - return; + no_more_source: + detect_info->found |= found; + return 1; } -/* See "GENERAL NOTES about `encode_coding_XXX ()' functions". Encode - format of end-of-line according to `coding->eol_type'. It also - convert multibyte form 8-bit characters to unibyte if - CODING->src_multibyte is nonzero. If `coding->mode & - CODING_MODE_SELECTIVE_DISPLAY' is nonzero, code '\r' in source text - also means end-of-line. */ - static void -encode_eol (coding, source, destination, src_bytes, dst_bytes) +decode_coding_charset (coding) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; { - const unsigned char *src = source; - unsigned char *dst = destination; - const unsigned char *src_end = src + src_bytes; - unsigned char *dst_end = dst + dst_bytes; - Lisp_Object translation_table; - /* SRC_BASE remembers the start position in source in each loop. - The loop will be exited when there's not enough source text to - analyze multi-byte codes (within macro ONE_MORE_CHAR), or when - there's not enough destination area to produce encoded codes - (within macro EMIT_BYTES). */ + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; const unsigned char *src_base; - unsigned char *tmp; - int c; - int selective_display = coding->mode & CODING_MODE_SELECTIVE_DISPLAY; + int *charbuf = coding->charbuf + coding->charbuf_used; + int *charbuf_end + = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH; + int consumed_chars = 0, consumed_chars_base; + int multibytep = coding->src_multibyte; + Lisp_Object attrs, charset_list, valids; + int char_offset = coding->produced_char; + int last_offset = char_offset; + int last_id = charset_ascii; + + CODING_GET_INFO (coding, attrs, charset_list); + valids = AREF (attrs, coding_attr_charset_valids); - translation_table = Qnil; - if (coding->src_multibyte - && *(src_end - 1) == LEADING_CODE_8_BIT_CONTROL) + while (1) { - src_end--; - src_bytes--; - coding->result = CODING_FINISH_INSUFFICIENT_SRC; - } + int c; + Lisp_Object val; + struct charset *charset; + int dim; + int len = 1; + unsigned code; - if (coding->eol_type == CODING_EOL_CRLF) - { - while (src < src_end) - { - src_base = src; - c = *src++; - if (c >= 0x20) - EMIT_ONE_BYTE (c); - else if (c == '\n' || (c == '\r' && selective_display)) - EMIT_TWO_BYTES ('\r', '\n'); - else - EMIT_ONE_BYTE (c); - } src_base = src; - label_end_of_loop: - ; - } - else - { - if (!dst_bytes || src_bytes <= dst_bytes) + consumed_chars_base = consumed_chars; + + if (charbuf >= charbuf_end) + break; + + ONE_MORE_BYTE (c); + if (c < 0) + goto invalid_code; + code = c; + + val = AREF (valids, c); + if (NILP (val)) + goto invalid_code; + if (INTEGERP (val)) { - safe_bcopy (src, dst, src_bytes); - src_base = src_end; - dst += src_bytes; + charset = CHARSET_FROM_ID (XFASTINT (val)); + dim = CHARSET_DIMENSION (charset); + while (len < dim) + { + ONE_MORE_BYTE (c); + code = (code << 8) | c; + len++; + } + CODING_DECODE_CHAR (coding, src, src_base, src_end, + charset, code, c); } else { - if (coding->src_multibyte - && *(src + dst_bytes - 1) == LEADING_CODE_8_BIT_CONTROL) - dst_bytes--; - safe_bcopy (src, dst, dst_bytes); - src_base = src + dst_bytes; - dst = destination + dst_bytes; - coding->result = CODING_FINISH_INSUFFICIENT_DST; + /* VAL is a list of charset IDs. It is assured that the + list is sorted by charset dimensions (smaller one + comes first). */ + while (CONSP (val)) + { + charset = CHARSET_FROM_ID (XFASTINT (XCAR (val))); + dim = CHARSET_DIMENSION (charset); + while (len < dim) + { + ONE_MORE_BYTE (c); + code = (code << 8) | c; + len++; + } + CODING_DECODE_CHAR (coding, src, src_base, + src_end, charset, code, c); + if (c >= 0) + break; + val = XCDR (val); + } + } + if (c < 0) + goto invalid_code; + if (charset->id != charset_ascii + && last_id != charset->id) + { + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + last_id = charset->id; + last_offset = char_offset; } - if (coding->eol_type == CODING_EOL_CR) + + *charbuf++ = c; + char_offset++; + continue; + + invalid_code: + src = src_base; + consumed_chars = consumed_chars_base; + ONE_MORE_BYTE (c); + *charbuf++ = c < 0 ? -c : ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c); + char_offset++; + coding->errors++; + } + + no_more_source: + if (last_id != charset_ascii) + ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id); + coding->consumed_char += consumed_chars_base; + coding->consumed = src_base - coding->source; + coding->charbuf_used = charbuf - coding->charbuf; +} + +static int +encode_coding_charset (coding) + struct coding_system *coding; +{ + int multibytep = coding->dst_multibyte; + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int safe_room = MAX_MULTIBYTE_LENGTH; + int produced_chars = 0; + Lisp_Object attrs, charset_list; + int ascii_compatible; + int c; + + CODING_GET_INFO (coding, attrs, charset_list); + ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); + + while (charbuf < charbuf_end) + { + struct charset *charset; + unsigned code; + + ASSURE_DESTINATION (safe_room); + c = *charbuf++; + if (ascii_compatible && ASCII_CHAR_P (c)) + EMIT_ONE_ASCII_BYTE (c); + else if (CHAR_BYTE8_P (c)) { - for (tmp = destination; tmp < dst; tmp++) - if (*tmp == '\n') *tmp = '\r'; + c = CHAR_TO_BYTE8 (c); + EMIT_ONE_BYTE (c); } - else if (selective_display) + else { - for (tmp = destination; tmp < dst; tmp++) - if (*tmp == '\r') *tmp = '\n'; + charset = char_charset (c, charset_list, &code); + if (charset) + { + if (CHARSET_DIMENSION (charset) == 1) + EMIT_ONE_BYTE (code); + else if (CHARSET_DIMENSION (charset) == 2) + EMIT_TWO_BYTES (code >> 8, code & 0xFF); + else if (CHARSET_DIMENSION (charset) == 3) + EMIT_THREE_BYTES (code >> 16, (code >> 8) & 0xFF, code & 0xFF); + else + EMIT_FOUR_BYTES (code >> 24, (code >> 16) & 0xFF, + (code >> 8) & 0xFF, code & 0xFF); + } + else + { + if (coding->mode & CODING_MODE_SAFE_ENCODING) + c = CODING_INHIBIT_CHARACTER_SUBSTITUTION; + else + c = coding->default_char; + EMIT_ONE_BYTE (c); + } } } - if (coding->src_multibyte) - dst = destination + str_as_unibyte (destination, dst - destination); - coding->consumed = src_base - source; - coding->produced = dst - destination; - coding->produced_char = coding->produced; + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->produced_char += produced_chars; + coding->produced = dst - coding->destination; + return 0; } /*** 7. C library functions ***/ -/* In Emacs Lisp, a coding system is represented by a Lisp symbol which - has a property `coding-system'. The value of this property is a - vector of length 5 (called the coding-vector). Among elements of - this vector, the first (element[0]) and the fifth (element[4]) - carry important information for decoding/encoding. Before - decoding/encoding, this information should be set in fields of a - structure of type `coding_system'. - - The value of the property `coding-system' can be a symbol of another - subsidiary coding-system. In that case, Emacs gets coding-vector - from that symbol. - - `element[0]' contains information to be set in `coding->type'. The - value and its meaning is as follows: - - 0 -- coding_type_emacs_mule - 1 -- coding_type_sjis - 2 -- coding_type_iso2022 - 3 -- coding_type_big5 - 4 -- coding_type_ccl encoder/decoder written in CCL - nil -- coding_type_no_conversion - t -- coding_type_undecided (automatic conversion on decoding, - no-conversion on encoding) - - `element[4]' contains information to be set in `coding->flags' and - `coding->spec'. The meaning varies by `coding->type'. - - If `coding->type' is `coding_type_iso2022', element[4] is a vector - of length 32 (of which the first 13 sub-elements are used now). - Meanings of these sub-elements are: - - sub-element[N] where N is 0 through 3: to be set in `coding->spec.iso2022' - If the value is an integer of valid charset, the charset is - assumed to be designated to graphic register N initially. - - If the value is minus, it is a minus value of charset which - reserves graphic register N, which means that the charset is - not designated initially but should be designated to graphic - register N just before encoding a character in that charset. - - If the value is nil, graphic register N is never used on - encoding. - - sub-element[N] where N is 4 through 11: to be set in `coding->flags' - Each value takes t or nil. See the section ISO2022 of - `coding.h' for more information. - - If `coding->type' is `coding_type_big5', element[4] is t to denote - BIG5-ETen or nil to denote BIG5-HKU. - - If `coding->type' takes the other value, element[4] is ignored. - - Emacs Lisp's coding systems also carry information about format of - end-of-line in a value of property `eol-type'. If the value is - integer, 0 means CODING_EOL_LF, 1 means CODING_EOL_CRLF, and 2 - means CODING_EOL_CR. If it is not integer, it should be a vector - of subsidiary coding systems of which property `eol-type' has one - of the above values. - -*/ - -/* Extract information for decoding/encoding from CODING_SYSTEM_SYMBOL - and set it in CODING. If CODING_SYSTEM_SYMBOL is invalid, CODING - is setup so that no conversion is necessary and return -1, else - return 0. */ +/* Setup coding context CODING from information about CODING_SYSTEM. + If CODING_SYSTEM is nil, `no-conversion' is assumed. If + CODING_SYSTEM is invalid, signal an error. */ -int +void setup_coding_system (coding_system, coding) Lisp_Object coding_system; struct coding_system *coding; { - Lisp_Object coding_spec, coding_type, eol_type, plist; + Lisp_Object attrs; + Lisp_Object eol_type; + Lisp_Object coding_type; Lisp_Object val; - /* At first, zero clear all members. */ - bzero (coding, sizeof (struct coding_system)); - - /* Initialize some fields required for all kinds of coding systems. */ - coding->symbol = coding_system; - coding->heading_ascii = -1; - coding->post_read_conversion = coding->pre_write_conversion = Qnil; - coding->composing = COMPOSITION_DISABLED; - coding->cmp_data = NULL; - if (NILP (coding_system)) - goto label_invalid_coding_system; + coding_system = Qundecided; - coding_spec = Fget (coding_system, Qcoding_system); + CHECK_CODING_SYSTEM_GET_ID (coding_system, coding->id); - if (!VECTORP (coding_spec) - || XVECTOR (coding_spec)->size != 5 - || !CONSP (XVECTOR (coding_spec)->contents[3])) - goto label_invalid_coding_system; + attrs = CODING_ID_ATTRS (coding->id); + eol_type = CODING_ID_EOL_TYPE (coding->id); - eol_type = inhibit_eol_conversion ? Qnil : Fget (coding_system, Qeol_type); + coding->mode = 0; + coding->head_ascii = -1; if (VECTORP (eol_type)) + coding->common_flags = (CODING_REQUIRE_DECODING_MASK + | CODING_REQUIRE_DETECTION_MASK); + else if (! EQ (eol_type, Qunix)) + coding->common_flags = (CODING_REQUIRE_DECODING_MASK + | CODING_REQUIRE_ENCODING_MASK); + else + coding->common_flags = 0; + if (! NILP (CODING_ATTR_POST_READ (attrs))) + coding->common_flags |= CODING_REQUIRE_DECODING_MASK; + if (! NILP (CODING_ATTR_PRE_WRITE (attrs))) + coding->common_flags |= CODING_REQUIRE_ENCODING_MASK; + if (! NILP (CODING_ATTR_FOR_UNIBYTE (attrs))) + coding->common_flags |= CODING_FOR_UNIBYTE_MASK; + + val = CODING_ATTR_SAFE_CHARSETS (attrs); + coding->max_charset_id = SCHARS (val) - 1; + coding->safe_charsets = (char *) SDATA (val); + coding->default_char = XINT (CODING_ATTR_DEFAULT_CHAR (attrs)); + + coding_type = CODING_ATTR_TYPE (attrs); + if (EQ (coding_type, Qundecided)) { - coding->eol_type = CODING_EOL_UNDECIDED; - coding->common_flags = CODING_REQUIRE_DETECTION_MASK; - if (system_eol_type != CODING_EOL_LF) - coding->common_flags |= CODING_REQUIRE_ENCODING_MASK; + coding->detector = NULL; + coding->decoder = decode_coding_raw_text; + coding->encoder = encode_coding_raw_text; + coding->common_flags |= CODING_REQUIRE_DETECTION_MASK; } - else if (XFASTINT (eol_type) == 1) + else if (EQ (coding_type, Qiso_2022)) { - coding->eol_type = CODING_EOL_CRLF; + int i; + int flags = XINT (AREF (attrs, coding_attr_iso_flags)); + + /* Invoke graphic register 0 to plane 0. */ + CODING_ISO_INVOCATION (coding, 0) = 0; + /* Invoke graphic register 1 to plane 1 if we can use 8-bit. */ + CODING_ISO_INVOCATION (coding, 1) + = (flags & CODING_ISO_FLAG_SEVEN_BITS ? -1 : 1); + /* Setup the initial status of designation. */ + for (i = 0; i < 4; i++) + CODING_ISO_DESIGNATION (coding, i) = CODING_ISO_INITIAL (coding, i); + /* Not single shifting initially. */ + CODING_ISO_SINGLE_SHIFTING (coding) = 0; + /* Beginning of buffer should also be regarded as bol. */ + CODING_ISO_BOL (coding) = 1; + coding->detector = detect_coding_iso_2022; + coding->decoder = decode_coding_iso_2022; + coding->encoder = encode_coding_iso_2022; + if (flags & CODING_ISO_FLAG_SAFE) + coding->mode |= CODING_MODE_SAFE_ENCODING; coding->common_flags - = CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK; + |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK + | CODING_REQUIRE_FLUSHING_MASK); + if (flags & CODING_ISO_FLAG_COMPOSITION) + coding->common_flags |= CODING_ANNOTATE_COMPOSITION_MASK; + if (flags & CODING_ISO_FLAG_DESIGNATION) + coding->common_flags |= CODING_ANNOTATE_CHARSET_MASK; + if (flags & CODING_ISO_FLAG_FULL_SUPPORT) + { + setup_iso_safe_charsets (attrs); + val = CODING_ATTR_SAFE_CHARSETS (attrs); + coding->max_charset_id = SCHARS (val) - 1; + coding->safe_charsets = (char *) SDATA (val); + } + CODING_ISO_FLAGS (coding) = flags; } - else if (XFASTINT (eol_type) == 2) + else if (EQ (coding_type, Qcharset)) { - coding->eol_type = CODING_EOL_CR; + coding->detector = detect_coding_charset; + coding->decoder = decode_coding_charset; + coding->encoder = encode_coding_charset; coding->common_flags - = CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK; + |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK); } - else + else if (EQ (coding_type, Qutf_8)) { - coding->common_flags = 0; - coding->eol_type = CODING_EOL_LF; + coding->detector = detect_coding_utf_8; + coding->decoder = decode_coding_utf_8; + coding->encoder = encode_coding_utf_8; + coding->common_flags + |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK); + } + else if (EQ (coding_type, Qutf_16)) + { + val = AREF (attrs, coding_attr_utf_16_bom); + CODING_UTF_16_BOM (coding) = (CONSP (val) ? utf_16_detect_bom + : EQ (val, Qt) ? utf_16_with_bom + : utf_16_without_bom); + val = AREF (attrs, coding_attr_utf_16_endian); + CODING_UTF_16_ENDIAN (coding) = (EQ (val, Qbig) ? utf_16_big_endian + : utf_16_little_endian); + CODING_UTF_16_SURROGATE (coding) = 0; + coding->detector = detect_coding_utf_16; + coding->decoder = decode_coding_utf_16; + coding->encoder = encode_coding_utf_16; + coding->common_flags + |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK); + if (CODING_UTF_16_BOM (coding) == utf_16_detect_bom) + coding->common_flags |= CODING_REQUIRE_DETECTION_MASK; } - - coding_type = XVECTOR (coding_spec)->contents[0]; - /* Try short cut. */ - if (SYMBOLP (coding_type)) + else if (EQ (coding_type, Qccl)) { - if (EQ (coding_type, Qt)) + coding->detector = detect_coding_ccl; + coding->decoder = decode_coding_ccl; + coding->encoder = encode_coding_ccl; + coding->common_flags + |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK + | CODING_REQUIRE_FLUSHING_MASK); + } + else if (EQ (coding_type, Qemacs_mule)) + { + coding->detector = detect_coding_emacs_mule; + coding->decoder = decode_coding_emacs_mule; + coding->encoder = encode_coding_emacs_mule; + coding->common_flags + |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK); + if (! NILP (AREF (attrs, coding_attr_emacs_mule_full)) + && ! EQ (CODING_ATTR_CHARSET_LIST (attrs), Vemacs_mule_charset_list)) { - coding->type = coding_type_undecided; - coding->common_flags |= CODING_REQUIRE_DETECTION_MASK; + Lisp_Object tail, safe_charsets; + int max_charset_id = 0; + + for (tail = Vemacs_mule_charset_list; CONSP (tail); + tail = XCDR (tail)) + if (max_charset_id < XFASTINT (XCAR (tail))) + max_charset_id = XFASTINT (XCAR (tail)); + safe_charsets = Fmake_string (make_number (max_charset_id + 1), + make_number (255)); + for (tail = Vemacs_mule_charset_list; CONSP (tail); + tail = XCDR (tail)) + SSET (safe_charsets, XFASTINT (XCAR (tail)), 0); + coding->max_charset_id = max_charset_id; + coding->safe_charsets = (char *) SDATA (safe_charsets); } - else - coding->type = coding_type_no_conversion; - /* Initialize this member. Any thing other than - CODING_CATEGORY_IDX_UTF_16_BE and - CODING_CATEGORY_IDX_UTF_16_LE are ok because they have - special treatment in detect_eol. */ - coding->category_idx = CODING_CATEGORY_IDX_EMACS_MULE; - - return 0; - } - - /* Get values of coding system properties: - `post-read-conversion', `pre-write-conversion', - `translation-table-for-decode', `translation-table-for-encode'. */ - plist = XVECTOR (coding_spec)->contents[3]; - /* Pre & post conversion functions should be disabled if - inhibit_eol_conversion is nonzero. This is the case that a code - conversion function is called while those functions are running. */ - if (! inhibit_pre_post_conversion) - { - coding->post_read_conversion = Fplist_get (plist, Qpost_read_conversion); - coding->pre_write_conversion = Fplist_get (plist, Qpre_write_conversion); - } - val = Fplist_get (plist, Qtranslation_table_for_decode); - if (SYMBOLP (val)) - val = Fget (val, Qtranslation_table_for_decode); - coding->translation_table_for_decode = CHAR_TABLE_P (val) ? val : Qnil; - val = Fplist_get (plist, Qtranslation_table_for_encode); - if (SYMBOLP (val)) - val = Fget (val, Qtranslation_table_for_encode); - coding->translation_table_for_encode = CHAR_TABLE_P (val) ? val : Qnil; - val = Fplist_get (plist, Qcoding_category); - if (!NILP (val)) - { - val = Fget (val, Qcoding_category_index); - if (INTEGERP (val)) - coding->category_idx = XINT (val); - else - goto label_invalid_coding_system; } - else - goto label_invalid_coding_system; - - /* If the coding system has non-nil `composition' property, enable - composition handling. */ - val = Fplist_get (plist, Qcomposition); - if (!NILP (val)) - coding->composing = COMPOSITION_NO; - - /* If the coding system is ascii-incompatible, record it in - common_flags. */ - val = Fplist_get (plist, Qascii_incompatible); - if (! NILP (val)) - coding->common_flags |= CODING_ASCII_INCOMPATIBLE_MASK; - - switch (XFASTINT (coding_type)) + else if (EQ (coding_type, Qshift_jis)) { - case 0: - coding->type = coding_type_emacs_mule; - coding->common_flags - |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK; - if (!NILP (coding->post_read_conversion)) - coding->common_flags |= CODING_REQUIRE_DECODING_MASK; - if (!NILP (coding->pre_write_conversion)) - coding->common_flags |= CODING_REQUIRE_ENCODING_MASK; - break; - - case 1: - coding->type = coding_type_sjis; - coding->common_flags - |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK; - break; - - case 2: - coding->type = coding_type_iso2022; + coding->detector = detect_coding_sjis; + coding->decoder = decode_coding_sjis; + coding->encoder = encode_coding_sjis; coding->common_flags - |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK; - { - Lisp_Object val, temp; - Lisp_Object *flags; - int i, charset, reg_bits = 0; - - val = XVECTOR (coding_spec)->contents[4]; - - if (!VECTORP (val) || XVECTOR (val)->size != 32) - goto label_invalid_coding_system; - - flags = XVECTOR (val)->contents; - coding->flags - = ((NILP (flags[4]) ? 0 : CODING_FLAG_ISO_SHORT_FORM) - | (NILP (flags[5]) ? 0 : CODING_FLAG_ISO_RESET_AT_EOL) - | (NILP (flags[6]) ? 0 : CODING_FLAG_ISO_RESET_AT_CNTL) - | (NILP (flags[7]) ? 0 : CODING_FLAG_ISO_SEVEN_BITS) - | (NILP (flags[8]) ? 0 : CODING_FLAG_ISO_LOCKING_SHIFT) - | (NILP (flags[9]) ? 0 : CODING_FLAG_ISO_SINGLE_SHIFT) - | (NILP (flags[10]) ? 0 : CODING_FLAG_ISO_USE_ROMAN) - | (NILP (flags[11]) ? 0 : CODING_FLAG_ISO_USE_OLDJIS) - | (NILP (flags[12]) ? 0 : CODING_FLAG_ISO_NO_DIRECTION) - | (NILP (flags[13]) ? 0 : CODING_FLAG_ISO_INIT_AT_BOL) - | (NILP (flags[14]) ? 0 : CODING_FLAG_ISO_DESIGNATE_AT_BOL) - | (NILP (flags[15]) ? 0 : CODING_FLAG_ISO_SAFE) - | (NILP (flags[16]) ? 0 : CODING_FLAG_ISO_LATIN_EXTRA) - ); - - /* Invoke graphic register 0 to plane 0. */ - CODING_SPEC_ISO_INVOCATION (coding, 0) = 0; - /* Invoke graphic register 1 to plane 1 if we can use full 8-bit. */ - CODING_SPEC_ISO_INVOCATION (coding, 1) - = (coding->flags & CODING_FLAG_ISO_SEVEN_BITS ? -1 : 1); - /* Not single shifting at first. */ - CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 0; - /* Beginning of buffer should also be regarded as bol. */ - CODING_SPEC_ISO_BOL (coding) = 1; - - for (charset = 0; charset <= MAX_CHARSET; charset++) - CODING_SPEC_ISO_REVISION_NUMBER (coding, charset) = 255; - val = Vcharset_revision_alist; - while (CONSP (val)) - { - charset = get_charset_id (Fcar_safe (XCAR (val))); - if (charset >= 0 - && (temp = Fcdr_safe (XCAR (val)), INTEGERP (temp)) - && (i = XINT (temp), (i >= 0 && (i + '@') < 128))) - CODING_SPEC_ISO_REVISION_NUMBER (coding, charset) = i; - val = XCDR (val); - } - - /* Checks FLAGS[REG] (REG = 0, 1, 2 3) and decide designations. - FLAGS[REG] can be one of below: - integer CHARSET: CHARSET occupies register I, - t: designate nothing to REG initially, but can be used - by any charsets, - list of integer, nil, or t: designate the first - element (if integer) to REG initially, the remaining - elements (if integer) is designated to REG on request, - if an element is t, REG can be used by any charsets, - nil: REG is never used. */ - for (charset = 0; charset <= MAX_CHARSET; charset++) - CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) - = CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION; - for (i = 0; i < 4; i++) - { - if ((INTEGERP (flags[i]) - && (charset = XINT (flags[i]), CHARSET_VALID_P (charset))) - || (charset = get_charset_id (flags[i])) >= 0) - { - CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = charset; - CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) = i; - } - else if (EQ (flags[i], Qt)) - { - CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1; - reg_bits |= 1 << i; - coding->flags |= CODING_FLAG_ISO_DESIGNATION; - } - else if (CONSP (flags[i])) - { - Lisp_Object tail; - tail = flags[i]; - - coding->flags |= CODING_FLAG_ISO_DESIGNATION; - if ((INTEGERP (XCAR (tail)) - && (charset = XINT (XCAR (tail)), - CHARSET_VALID_P (charset))) - || (charset = get_charset_id (XCAR (tail))) >= 0) - { - CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = charset; - CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) =i; - } - else - CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1; - tail = XCDR (tail); - while (CONSP (tail)) - { - if ((INTEGERP (XCAR (tail)) - && (charset = XINT (XCAR (tail)), - CHARSET_VALID_P (charset))) - || (charset = get_charset_id (XCAR (tail))) >= 0) - CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) - = i; - else if (EQ (XCAR (tail), Qt)) - reg_bits |= 1 << i; - tail = XCDR (tail); - } - } - else - CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1; - - CODING_SPEC_ISO_DESIGNATION (coding, i) - = CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i); - } - - if (reg_bits && ! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT)) - { - /* REG 1 can be used only by locking shift in 7-bit env. */ - if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) - reg_bits &= ~2; - if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)) - /* Without any shifting, only REG 0 and 1 can be used. */ - reg_bits &= 3; - } - - if (reg_bits) - for (charset = 0; charset <= MAX_CHARSET; charset++) - { - if (CHARSET_DEFINED_P (charset) - && (CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) - == CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION)) - { - /* There exist some default graphic registers to be - used by CHARSET. */ - - /* We had better avoid designating a charset of - CHARS96 to REG 0 as far as possible. */ - if (CHARSET_CHARS (charset) == 96) - CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) - = (reg_bits & 2 - ? 1 : (reg_bits & 4 ? 2 : (reg_bits & 8 ? 3 : 0))); - else - CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) - = (reg_bits & 1 - ? 0 : (reg_bits & 2 ? 1 : (reg_bits & 4 ? 2 : 3))); - } - } - } - coding->common_flags |= CODING_REQUIRE_FLUSHING_MASK; - coding->spec.iso2022.last_invalid_designation_register = -1; - break; - - case 3: - coding->type = coding_type_big5; - coding->common_flags - |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK; - coding->flags - = (NILP (XVECTOR (coding_spec)->contents[4]) - ? CODING_FLAG_BIG5_HKU - : CODING_FLAG_BIG5_ETEN); - break; - - case 4: - coding->type = coding_type_ccl; + |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK); + } + else if (EQ (coding_type, Qbig5)) + { + coding->detector = detect_coding_big5; + coding->decoder = decode_coding_big5; + coding->encoder = encode_coding_big5; coding->common_flags - |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK; - { - val = XVECTOR (coding_spec)->contents[4]; - if (! CONSP (val) - || setup_ccl_program (&(coding->spec.ccl.decoder), - XCAR (val)) < 0 - || setup_ccl_program (&(coding->spec.ccl.encoder), - XCDR (val)) < 0) - goto label_invalid_coding_system; - - bzero (coding->spec.ccl.valid_codes, 256); - val = Fplist_get (plist, Qvalid_codes); - if (CONSP (val)) - { - Lisp_Object this; - - for (; CONSP (val); val = XCDR (val)) - { - this = XCAR (val); - if (INTEGERP (this) - && XINT (this) >= 0 && XINT (this) < 256) - coding->spec.ccl.valid_codes[XINT (this)] = 1; - else if (CONSP (this) - && INTEGERP (XCAR (this)) - && INTEGERP (XCDR (this))) - { - int start = XINT (XCAR (this)); - int end = XINT (XCDR (this)); - - if (start >= 0 && start <= end && end < 256) - while (start <= end) - coding->spec.ccl.valid_codes[start++] = 1; - } - } - } - } - coding->common_flags |= CODING_REQUIRE_FLUSHING_MASK; - coding->spec.ccl.cr_carryover = 0; - coding->spec.ccl.eight_bit_carryover[0] = 0; - break; - - case 5: - coding->type = coding_type_raw_text; - break; + |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK); + } + else /* EQ (coding_type, Qraw_text) */ + { + coding->detector = NULL; + coding->decoder = decode_coding_raw_text; + coding->encoder = encode_coding_raw_text; + if (! EQ (eol_type, Qunix)) + { + coding->common_flags |= CODING_REQUIRE_DECODING_MASK; + if (! VECTORP (eol_type)) + coding->common_flags |= CODING_REQUIRE_ENCODING_MASK; + } - default: - goto label_invalid_coding_system; } - return 0; - label_invalid_coding_system: - coding->type = coding_type_no_conversion; - coding->category_idx = CODING_CATEGORY_IDX_BINARY; - coding->common_flags = 0; - coding->eol_type = CODING_EOL_UNDECIDED; - coding->pre_write_conversion = coding->post_read_conversion = Qnil; - return NILP (coding_system) ? 0 : -1; + return; } -/* Free memory blocks allocated for storing composition information. */ +/* Return a list of charsets supported by CODING. */ -void -coding_free_composition_data (coding) +Lisp_Object +coding_charset_list (coding) struct coding_system *coding; { - struct composition_data *cmp_data = coding->cmp_data, *next; + Lisp_Object attrs, charset_list; - if (!cmp_data) - return; - /* Memory blocks are chained. At first, rewind to the first, then, - free blocks one by one. */ - while (cmp_data->prev) - cmp_data = cmp_data->prev; - while (cmp_data) + CODING_GET_INFO (coding, attrs, charset_list); + if (EQ (CODING_ATTR_TYPE (attrs), Qiso_2022)) + { + int flags = XINT (AREF (attrs, coding_attr_iso_flags)); + + if (flags & CODING_ISO_FLAG_FULL_SUPPORT) + charset_list = Viso_2022_charset_list; + } + else if (EQ (CODING_ATTR_TYPE (attrs), Qemacs_mule)) { - next = cmp_data->next; - xfree (cmp_data); - cmp_data = next; + charset_list = Vemacs_mule_charset_list; } - coding->cmp_data = NULL; + return charset_list; } -/* Set `char_offset' member of all memory blocks pointed by - coding->cmp_data to POS. */ -void -coding_adjust_composition_offset (coding, pos) - struct coding_system *coding; - int pos; +/* Return raw-text or one of its subsidiaries that has the same + eol_type as CODING-SYSTEM. */ + +Lisp_Object +raw_text_coding_system (coding_system) + Lisp_Object coding_system; { - struct composition_data *cmp_data; + Lisp_Object spec, attrs; + Lisp_Object eol_type, raw_text_eol_type; + + if (NILP (coding_system)) + return Qraw_text; + spec = CODING_SYSTEM_SPEC (coding_system); + attrs = AREF (spec, 0); + + if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text)) + return coding_system; - for (cmp_data = coding->cmp_data; cmp_data; cmp_data = cmp_data->next) - cmp_data->char_offset = pos; + eol_type = AREF (spec, 2); + if (VECTORP (eol_type)) + return Qraw_text; + spec = CODING_SYSTEM_SPEC (Qraw_text); + raw_text_eol_type = AREF (spec, 2); + return (EQ (eol_type, Qunix) ? AREF (raw_text_eol_type, 0) + : EQ (eol_type, Qdos) ? AREF (raw_text_eol_type, 1) + : AREF (raw_text_eol_type, 2)); } -/* Setup raw-text or one of its subsidiaries in the structure - coding_system CODING according to the already setup value eol_type - in CODING. CODING should be setup for some coding system in - advance. */ -void -setup_raw_text_coding_system (coding) - struct coding_system *coding; +/* If CODING_SYSTEM doesn't specify end-of-line format but PARENT + does, return one of the subsidiary that has the same eol-spec as + PARENT. Otherwise, return CODING_SYSTEM. If PARENT is nil, + inherit end-of-line format from the system's setting + (system_eol_type). */ + +Lisp_Object +coding_inherit_eol_type (coding_system, parent) + Lisp_Object coding_system, parent; { - if (coding->type != coding_type_raw_text) + Lisp_Object spec, eol_type; + + if (NILP (coding_system)) + coding_system = Qraw_text; + spec = CODING_SYSTEM_SPEC (coding_system); + eol_type = AREF (spec, 2); + if (VECTORP (eol_type)) { - coding->symbol = Qraw_text; - coding->type = coding_type_raw_text; - if (coding->eol_type != CODING_EOL_UNDECIDED) + Lisp_Object parent_eol_type; + + if (! NILP (parent)) { - Lisp_Object subsidiaries; - subsidiaries = Fget (Qraw_text, Qeol_type); + Lisp_Object parent_spec; - if (VECTORP (subsidiaries) - && XVECTOR (subsidiaries)->size == 3) - coding->symbol - = XVECTOR (subsidiaries)->contents[coding->eol_type]; + parent_spec = CODING_SYSTEM_SPEC (parent); + parent_eol_type = AREF (parent_spec, 2); } - setup_coding_system (coding->symbol, coding); - } - return; + else + parent_eol_type = system_eol_type; + if (EQ (parent_eol_type, Qunix)) + coding_system = AREF (eol_type, 0); + else if (EQ (parent_eol_type, Qdos)) + coding_system = AREF (eol_type, 1); + else if (EQ (parent_eol_type, Qmac)) + coding_system = AREF (eol_type, 2); + } + return coding_system; } /* Emacs has a mechanism to automatically detect a coding system if it @@ -4044,14 +5324,14 @@ setup_raw_text_coding_system (coding) o coding-category-iso-7-else The category for a coding system which has the same code range - as ISO2022 of 7-bit environment but uses locking shift or + as ISO2022 of 7-bit environemnt but uses locking shift or single shift functions. Assigned the coding-system (Lisp symbol) `iso-2022-7bit-lock' by default. o coding-category-iso-8-else The category for a coding system which has the same code range - as ISO2022 of 8-bit environment but uses locking shift or + as ISO2022 of 8-bit environemnt but uses locking shift or single shift functions. Assigned the coding-system (Lisp symbol) `iso-2022-8bit-ss2' by default. @@ -4094,2425 +5374,1788 @@ setup_raw_text_coding_system (coding) `no-conversion' by default. Each of them is a Lisp symbol and the value is an actual - `coding-system' (this is also a Lisp symbol) assigned by a user. + `coding-system's (this is also a Lisp symbol) assigned by a user. What Emacs does actually is to detect a category of coding system. Then, it uses a `coding-system' assigned to it. If Emacs can't - decide a single possible category, it selects a category of the + decide only one possible category, it selects a category of the highest priority. Priorities of categories are also specified by a user in a Lisp variable `coding-category-list'. */ -static -int ascii_skip_code[256]; +#define EOL_SEEN_NONE 0 +#define EOL_SEEN_LF 1 +#define EOL_SEEN_CR 2 +#define EOL_SEEN_CRLF 4 -/* Detect how a text of length SRC_BYTES pointed by SOURCE is encoded. - If it detects possible coding systems, return an integer in which - appropriate flag bits are set. Flag bits are defined by macros - CODING_CATEGORY_MASK_XXX in `coding.h'. If PRIORITIES is non-NULL, - it should point the table `coding_priorities'. In that case, only - the flag bit for a coding system of the highest priority is set in - the returned value. If MULTIBYTEP is nonzero, 8-bit codes of the - range 0x80..0x9F are in multibyte form. +/* Detect how end-of-line of a text of length SRC_BYTES pointed by + SOURCE is encoded. If CATEGORY is one of + coding_category_utf_16_XXXX, assume that CR and LF are encoded by + two-byte, else they are encoded by one-byte. + + Return one of EOL_SEEN_XXX. */ - How many ASCII characters are at the head is returned as *SKIP. */ +#define MAX_EOL_CHECK_COUNT 3 static int -detect_coding_mask (source, src_bytes, priorities, skip, multibytep) - unsigned char *source; - int src_bytes, *priorities, *skip; - int multibytep; +detect_eol (source, src_bytes, category) + const unsigned char *source; + EMACS_INT src_bytes; + enum coding_category category; { - register unsigned char c; - unsigned char *src = source, *src_end = source + src_bytes; - unsigned int mask, utf16_examined_p, iso2022_examined_p; - int i; + const unsigned char *src = source, *src_end = src + src_bytes; + unsigned char c; + int total = 0; + int eol_seen = EOL_SEEN_NONE; - /* At first, skip all ASCII characters and control characters except - for three ISO2022 specific control characters. */ - ascii_skip_code[ISO_CODE_SO] = 0; - ascii_skip_code[ISO_CODE_SI] = 0; - ascii_skip_code[ISO_CODE_ESC] = 0; - - label_loop_detect_coding: - while (src < src_end && ascii_skip_code[*src]) src++; - *skip = src - source; - - if (src >= src_end) - /* We found nothing other than ASCII. There's nothing to do. */ - return 0; - - c = *src; - /* The text seems to be encoded in some multilingual coding system. - Now, try to find in which coding system the text is encoded. */ - if (c < 0x80) - { - /* i.e. (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO) */ - /* C is an ISO2022 specific control code of C0. */ - mask = detect_coding_iso2022 (src, src_end, multibytep); - if (mask == 0) - { - /* No valid ISO2022 code follows C. Try again. */ - src++; - if (c == ISO_CODE_ESC) - ascii_skip_code[ISO_CODE_ESC] = 1; - else - ascii_skip_code[ISO_CODE_SO] = ascii_skip_code[ISO_CODE_SI] = 1; - goto label_loop_detect_coding; - } - if (priorities) + if ((1 << category) & CATEGORY_MASK_UTF_16) + { + int msb, lsb; + + msb = category == (coding_category_utf_16_le + | coding_category_utf_16_le_nosig); + lsb = 1 - msb; + + while (src + 1 < src_end) { - for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++) + c = src[lsb]; + if (src[msb] == 0 && (c == '\n' || c == '\r')) { - if (mask & priorities[i]) - return priorities[i]; + int this_eol; + + if (c == '\n') + this_eol = EOL_SEEN_LF; + else if (src + 3 >= src_end + || src[msb + 2] != 0 + || src[lsb + 2] != '\n') + this_eol = EOL_SEEN_CR; + else + this_eol = EOL_SEEN_CRLF; + + if (eol_seen == EOL_SEEN_NONE) + /* This is the first end-of-line. */ + eol_seen = this_eol; + else if (eol_seen != this_eol) + { + /* The found type is different from what found before. */ + eol_seen = EOL_SEEN_LF; + break; + } + if (++total == MAX_EOL_CHECK_COUNT) + break; } - return CODING_CATEGORY_MASK_RAW_TEXT; + src += 2; } } else { - int try; - - if (multibytep && c == LEADING_CODE_8_BIT_CONTROL) - c = src[1] - 0x20; - - if (c < 0xA0) - { - /* C is the first byte of SJIS character code, - or a leading-code of Emacs' internal format (emacs-mule), - or the first byte of UTF-16. */ - try = (CODING_CATEGORY_MASK_SJIS - | CODING_CATEGORY_MASK_EMACS_MULE - | CODING_CATEGORY_MASK_UTF_16_BE - | CODING_CATEGORY_MASK_UTF_16_LE); - - /* Or, if C is a special latin extra code, - or is an ISO2022 specific control code of C1 (SS2 or SS3), - or is an ISO2022 control-sequence-introducer (CSI), - we should also consider the possibility of ISO2022 codings. */ - if ((VECTORP (Vlatin_extra_code_table) - && !NILP (XVECTOR (Vlatin_extra_code_table)->contents[c])) - || (c == ISO_CODE_SS2 || c == ISO_CODE_SS3) - || (c == ISO_CODE_CSI - && (src < src_end - && (*src == ']' - || ((*src == '0' || *src == '1' || *src == '2') - && src + 1 < src_end - && src[1] == ']'))))) - try |= (CODING_CATEGORY_MASK_ISO_8_ELSE - | CODING_CATEGORY_MASK_ISO_8BIT); - } - else - /* C is a character of ISO2022 in graphic plane right, - or a SJIS's 1-byte character code (i.e. JISX0201), - or the first byte of BIG5's 2-byte code, - or the first byte of UTF-8/16. */ - try = (CODING_CATEGORY_MASK_ISO_8_ELSE - | CODING_CATEGORY_MASK_ISO_8BIT - | CODING_CATEGORY_MASK_SJIS - | CODING_CATEGORY_MASK_BIG5 - | CODING_CATEGORY_MASK_UTF_8 - | CODING_CATEGORY_MASK_UTF_16_BE - | CODING_CATEGORY_MASK_UTF_16_LE); - - /* Or, we may have to consider the possibility of CCL. */ - if (coding_system_table[CODING_CATEGORY_IDX_CCL] - && (coding_system_table[CODING_CATEGORY_IDX_CCL] - ->spec.ccl.valid_codes)[c]) - try |= CODING_CATEGORY_MASK_CCL; - - mask = 0; - utf16_examined_p = iso2022_examined_p = 0; - if (priorities) - { - for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++) + while (src < src_end) + { + c = *src++; + if (c == '\n' || c == '\r') { - if (!iso2022_examined_p - && (priorities[i] & try & CODING_CATEGORY_MASK_ISO)) - { - mask |= detect_coding_iso2022 (src, src_end, multibytep); - iso2022_examined_p = 1; - } - else if (priorities[i] & try & CODING_CATEGORY_MASK_SJIS) - mask |= detect_coding_sjis (src, src_end, multibytep); - else if (priorities[i] & try & CODING_CATEGORY_MASK_UTF_8) - mask |= detect_coding_utf_8 (src, src_end, multibytep); - else if (!utf16_examined_p - && (priorities[i] & try & - CODING_CATEGORY_MASK_UTF_16_BE_LE)) + int this_eol; + + if (c == '\n') + this_eol = EOL_SEEN_LF; + else if (src >= src_end || *src != '\n') + this_eol = EOL_SEEN_CR; + else + this_eol = EOL_SEEN_CRLF, src++; + + if (eol_seen == EOL_SEEN_NONE) + /* This is the first end-of-line. */ + eol_seen = this_eol; + else if (eol_seen != this_eol) { - mask |= detect_coding_utf_16 (src, src_end, multibytep); - utf16_examined_p = 1; + /* The found type is different from what found before. */ + eol_seen = EOL_SEEN_LF; + break; } - else if (priorities[i] & try & CODING_CATEGORY_MASK_BIG5) - mask |= detect_coding_big5 (src, src_end, multibytep); - else if (priorities[i] & try & CODING_CATEGORY_MASK_EMACS_MULE) - mask |= detect_coding_emacs_mule (src, src_end, multibytep); - else if (priorities[i] & try & CODING_CATEGORY_MASK_CCL) - mask |= detect_coding_ccl (src, src_end, multibytep); - else if (priorities[i] & CODING_CATEGORY_MASK_RAW_TEXT) - mask |= CODING_CATEGORY_MASK_RAW_TEXT; - else if (priorities[i] & CODING_CATEGORY_MASK_BINARY) - mask |= CODING_CATEGORY_MASK_BINARY; - if (mask & priorities[i]) - return priorities[i]; + if (++total == MAX_EOL_CHECK_COUNT) + break; } - return CODING_CATEGORY_MASK_RAW_TEXT; - } - if (try & CODING_CATEGORY_MASK_ISO) - mask |= detect_coding_iso2022 (src, src_end, multibytep); - if (try & CODING_CATEGORY_MASK_SJIS) - mask |= detect_coding_sjis (src, src_end, multibytep); - if (try & CODING_CATEGORY_MASK_BIG5) - mask |= detect_coding_big5 (src, src_end, multibytep); - if (try & CODING_CATEGORY_MASK_UTF_8) - mask |= detect_coding_utf_8 (src, src_end, multibytep); - if (try & CODING_CATEGORY_MASK_UTF_16_BE_LE) - mask |= detect_coding_utf_16 (src, src_end, multibytep); - if (try & CODING_CATEGORY_MASK_EMACS_MULE) - mask |= detect_coding_emacs_mule (src, src_end, multibytep); - if (try & CODING_CATEGORY_MASK_CCL) - mask |= detect_coding_ccl (src, src_end, multibytep); - } - return (mask | CODING_CATEGORY_MASK_RAW_TEXT | CODING_CATEGORY_MASK_BINARY); + } + } + return eol_seen; } -/* Detect how a text of length SRC_BYTES pointed by SRC is encoded. - The information of the detected coding system is set in CODING. */ -void -detect_coding (coding, src, src_bytes) +static Lisp_Object +adjust_coding_eol_type (coding, eol_seen) struct coding_system *coding; - const unsigned char *src; - int src_bytes; + int eol_seen; { - unsigned int idx; - int skip, mask; - Lisp_Object val; - - val = Vcoding_category_list; - mask = detect_coding_mask (src, src_bytes, coding_priorities, &skip, - coding->src_multibyte); - coding->heading_ascii = skip; - - if (!mask) return; + Lisp_Object eol_type; - /* We found a single coding system of the highest priority in MASK. */ - idx = 0; - while (mask && ! (mask & 1)) mask >>= 1, idx++; - if (! mask) - idx = CODING_CATEGORY_IDX_RAW_TEXT; - - val = find_symbol_value (XVECTOR (Vcoding_category_table)->contents[idx]); - - if (coding->eol_type != CODING_EOL_UNDECIDED) + eol_type = CODING_ID_EOL_TYPE (coding->id); + if (eol_seen & EOL_SEEN_LF) { - Lisp_Object tmp; - - tmp = Fget (val, Qeol_type); - if (VECTORP (tmp)) - val = XVECTOR (tmp)->contents[coding->eol_type]; + coding->id = CODING_SYSTEM_ID (AREF (eol_type, 0)); + eol_type = Qunix; } - - /* Setup this new coding system while preserving some slots. */ - { - int src_multibyte = coding->src_multibyte; - int dst_multibyte = coding->dst_multibyte; - - setup_coding_system (val, coding); - coding->src_multibyte = src_multibyte; - coding->dst_multibyte = dst_multibyte; - coding->heading_ascii = skip; - } + else if (eol_seen & EOL_SEEN_CRLF) + { + coding->id = CODING_SYSTEM_ID (AREF (eol_type, 1)); + eol_type = Qdos; + } + else if (eol_seen & EOL_SEEN_CR) + { + coding->id = CODING_SYSTEM_ID (AREF (eol_type, 2)); + eol_type = Qmac; + } + return eol_type; } -/* Detect how end-of-line of a text of length SRC_BYTES pointed by - SOURCE is encoded. Return one of CODING_EOL_LF, CODING_EOL_CRLF, - CODING_EOL_CR, and CODING_EOL_UNDECIDED. - - How many non-eol characters are at the head is returned as *SKIP. */ - -#define MAX_EOL_CHECK_COUNT 3 +/* Detect how a text specified in CODING is encoded. If a coding + system is detected, update fields of CODING by the detected coding + system. */ -static int -detect_eol_type (source, src_bytes, skip) - const unsigned char *source; - int src_bytes, *skip; +void +detect_coding (coding) + struct coding_system *coding; { - const unsigned char *src = source, *src_end = src + src_bytes; - unsigned char c; - int total = 0; /* How many end-of-lines are found so far. */ - int eol_type = CODING_EOL_UNDECIDED; - int this_eol_type; + const unsigned char *src, *src_end; + + coding->consumed = coding->consumed_char = 0; + coding->produced = coding->produced_char = 0; + coding_set_source (coding); - *skip = 0; + src_end = coding->source + coding->src_bytes; - while (src < src_end && total < MAX_EOL_CHECK_COUNT) + /* If we have not yet decided the text encoding type, detect it + now. */ + if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qundecided)) { - c = *src++; - if (c == '\n' || c == '\r') - { - if (*skip == 0) - *skip = src - 1 - source; - total++; - if (c == '\n') - this_eol_type = CODING_EOL_LF; - else if (src >= src_end || *src != '\n') - this_eol_type = CODING_EOL_CR; - else - this_eol_type = CODING_EOL_CRLF, src++; + int c, i; + struct coding_detection_info detect_info; - if (eol_type == CODING_EOL_UNDECIDED) - /* This is the first end-of-line. */ - eol_type = this_eol_type; - else if (eol_type != this_eol_type) + detect_info.checked = detect_info.found = detect_info.rejected = 0; + for (i = 0, src = coding->source; src < src_end; i++, src++) + { + c = *src; + if (c & 0x80) + break; + if (c < 0x20 + && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO) + && ! inhibit_iso_escape_detection + && ! detect_info.checked) { - /* The found type is different from what found before. */ - eol_type = CODING_EOL_INCONSISTENT; - break; + coding->head_ascii = src - (coding->source + coding->consumed); + if (detect_coding_iso_2022 (coding, &detect_info)) + { + /* We have scanned the whole data. */ + if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE)) + /* We didn't find an 8-bit code. */ + src = src_end; + break; + } } } + coding->head_ascii = src - (coding->source + coding->consumed); + + if (coding->head_ascii < coding->src_bytes + || detect_info.found) + { + enum coding_category category; + struct coding_system *this; + + if (coding->head_ascii == coding->src_bytes) + /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */ + for (i = 0; i < coding_category_raw_text; i++) + { + category = coding_priorities[i]; + this = coding_categories + category; + if (detect_info.found & (1 << category)) + break; + } + else + for (i = 0; i < coding_category_raw_text; i++) + { + category = coding_priorities[i]; + this = coding_categories + category; + if (this->id < 0) + { + /* No coding system of this category is defined. */ + detect_info.rejected |= (1 << category); + } + else if (category >= coding_category_raw_text) + continue; + else if (detect_info.checked & (1 << category)) + { + if (detect_info.found & (1 << category)) + break; + } + else if ((*(this->detector)) (coding, &detect_info) + && detect_info.found & (1 << category)) + { + if (category == coding_category_utf_16_auto) + { + if (detect_info.found & CATEGORY_MASK_UTF_16_LE) + category = coding_category_utf_16_le; + else + category = coding_category_utf_16_be; + } + break; + } + } + + if (i < coding_category_raw_text) + setup_coding_system (CODING_ID_NAME (this->id), coding); + else if (detect_info.rejected == CATEGORY_MASK_ANY) + setup_coding_system (Qraw_text, coding); + else if (detect_info.rejected) + for (i = 0; i < coding_category_raw_text; i++) + if (! (detect_info.rejected & (1 << coding_priorities[i]))) + { + this = coding_categories + coding_priorities[i]; + setup_coding_system (CODING_ID_NAME (this->id), coding); + break; + } + } } + else if (XINT (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id))) + == coding_category_utf_16_auto) + { + Lisp_Object coding_systems; + struct coding_detection_info detect_info; - if (*skip == 0) - *skip = src_end - source; - return eol_type; + coding_systems + = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_16_bom); + detect_info.found = detect_info.rejected = 0; + if (CONSP (coding_systems) + && detect_coding_utf_16 (coding, &detect_info)) + { + if (detect_info.found & CATEGORY_MASK_UTF_16_LE) + setup_coding_system (XCAR (coding_systems), coding); + else if (detect_info.found & CATEGORY_MASK_UTF_16_BE) + setup_coding_system (XCDR (coding_systems), coding); + } + } } -/* Like detect_eol_type, but detect EOL type in 2-octet - big-endian/little-endian format for coding systems utf-16-be and - utf-16-le. */ -static int -detect_eol_type_in_2_octet_form (source, src_bytes, skip, big_endian_p) - const unsigned char *source; - int src_bytes, *skip, big_endian_p; +static void +decode_eol (coding) + struct coding_system *coding; { - const unsigned char *src = source, *src_end = src + src_bytes; - unsigned int c1, c2; - int total = 0; /* How many end-of-lines are found so far. */ - int eol_type = CODING_EOL_UNDECIDED; - int this_eol_type; - int msb, lsb; - - if (big_endian_p) - msb = 0, lsb = 1; - else - msb = 1, lsb = 0; + Lisp_Object eol_type; + unsigned char *p, *pbeg, *pend; + + eol_type = CODING_ID_EOL_TYPE (coding->id); + if (EQ (eol_type, Qunix)) + return; - *skip = 0; + if (NILP (coding->dst_object)) + pbeg = coding->destination; + else + pbeg = BYTE_POS_ADDR (coding->dst_pos_byte); + pend = pbeg + coding->produced; - while ((src + 1) < src_end && total < MAX_EOL_CHECK_COUNT) + if (VECTORP (eol_type)) { - c1 = (src[msb] << 8) | (src[lsb]); - src += 2; + int eol_seen = EOL_SEEN_NONE; - if (c1 == '\n' || c1 == '\r') + for (p = pbeg; p < pend; p++) { - if (*skip == 0) - *skip = src - 2 - source; - total++; - if (c1 == '\n') - { - this_eol_type = CODING_EOL_LF; - } - else + if (*p == '\n') + eol_seen |= EOL_SEEN_LF; + else if (*p == '\r') { - if ((src + 1) >= src_end) + if (p + 1 < pend && *(p + 1) == '\n') { - this_eol_type = CODING_EOL_CR; + eol_seen |= EOL_SEEN_CRLF; + p++; } else - { - c2 = (src[msb] << 8) | (src[lsb]); - if (c2 == '\n') - this_eol_type = CODING_EOL_CRLF, src += 2; - else - this_eol_type = CODING_EOL_CR; - } - } - - if (eol_type == CODING_EOL_UNDECIDED) - /* This is the first end-of-line. */ - eol_type = this_eol_type; - else if (eol_type != this_eol_type) - { - /* The found type is different from what found before. */ - eol_type = CODING_EOL_INCONSISTENT; - break; + eol_seen |= EOL_SEEN_CR; } } + if (eol_seen != EOL_SEEN_NONE + && eol_seen != EOL_SEEN_LF + && eol_seen != EOL_SEEN_CRLF + && eol_seen != EOL_SEEN_CR) + eol_seen = EOL_SEEN_LF; + if (eol_seen != EOL_SEEN_NONE) + eol_type = adjust_coding_eol_type (coding, eol_seen); } - if (*skip == 0) - *skip = src_end - source; - return eol_type; -} - -/* Detect how end-of-line of a text of length SRC_BYTES pointed by SRC - is encoded. If it detects an appropriate format of end-of-line, it - sets the information in *CODING. */ - -void -detect_eol (coding, src, src_bytes) - struct coding_system *coding; - const unsigned char *src; - int src_bytes; -{ - Lisp_Object val; - int skip; - int eol_type; - - switch (coding->category_idx) + if (EQ (eol_type, Qmac)) { - case CODING_CATEGORY_IDX_UTF_16_BE: - eol_type = detect_eol_type_in_2_octet_form (src, src_bytes, &skip, 1); - break; - case CODING_CATEGORY_IDX_UTF_16_LE: - eol_type = detect_eol_type_in_2_octet_form (src, src_bytes, &skip, 0); - break; - default: - eol_type = detect_eol_type (src, src_bytes, &skip); - break; + for (p = pbeg; p < pend; p++) + if (*p == '\r') + *p = '\n'; } - - if (coding->heading_ascii > skip) - coding->heading_ascii = skip; - else - skip = coding->heading_ascii; - - if (eol_type == CODING_EOL_UNDECIDED) - return; - if (eol_type == CODING_EOL_INCONSISTENT) + else if (EQ (eol_type, Qdos)) { -#if 0 - /* This code is suppressed until we find a better way to - distinguish raw text file and binary file. */ + int n = 0; - /* If we have already detected that the coding is raw-text, the - coding should actually be no-conversion. */ - if (coding->type == coding_type_raw_text) + if (NILP (coding->dst_object)) { - setup_coding_system (Qno_conversion, coding); - return; + /* Start deleting '\r' from the tail to minimize the memory + movement. */ + for (p = pend - 2; p >= pbeg; p--) + if (*p == '\r') + { + safe_bcopy ((char *) (p + 1), (char *) p, pend-- - p - 1); + n++; + } } - /* Else, let's decode only text code anyway. */ -#endif /* 0 */ - eol_type = CODING_EOL_LF; - } - - val = Fget (coding->symbol, Qeol_type); - if (VECTORP (val) && XVECTOR (val)->size == 3) - { - int src_multibyte = coding->src_multibyte; - int dst_multibyte = coding->dst_multibyte; - struct composition_data *cmp_data = coding->cmp_data; + else + { + int pos_byte = coding->dst_pos_byte; + int pos = coding->dst_pos; + int pos_end = pos + coding->produced_char - 1; - setup_coding_system (XVECTOR (val)->contents[eol_type], coding); - coding->src_multibyte = src_multibyte; - coding->dst_multibyte = dst_multibyte; - coding->heading_ascii = skip; - coding->cmp_data = cmp_data; + while (pos < pos_end) + { + p = BYTE_POS_ADDR (pos_byte); + if (*p == '\r' && p[1] == '\n') + { + del_range_2 (pos, pos_byte, pos + 1, pos_byte + 1, 0); + n++; + pos_end--; + } + pos++; + pos_byte += BYTES_BY_CHAR_HEAD (*p); + } + } + coding->produced -= n; + coding->produced_char -= n; } } -#define CONVERSION_BUFFER_EXTRA_ROOM 256 - -#define DECODING_BUFFER_MAG(coding) \ - (coding->type == coding_type_iso2022 \ - ? 3 \ - : (coding->type == coding_type_ccl \ - ? coding->spec.ccl.decoder.buf_magnification \ - : 2)) - -/* Return maximum size (bytes) of a buffer enough for decoding - SRC_BYTES of text encoded in CODING. */ -int -decoding_buffer_size (coding, src_bytes) - struct coding_system *coding; - int src_bytes; -{ - return (src_bytes * DECODING_BUFFER_MAG (coding) - + CONVERSION_BUFFER_EXTRA_ROOM); -} - -/* Return maximum size (bytes) of a buffer enough for encoding - SRC_BYTES of text to CODING. */ +/* Return a translation table (or list of them) from coding system + attribute vector ATTRS for encoding (ENCODEP is nonzero) or + decoding (ENCODEP is zero). */ -int -encoding_buffer_size (coding, src_bytes) - struct coding_system *coding; - int src_bytes; +static Lisp_Object +get_translation_table (attrs, encodep, max_lookup) + Lisp_Object attrs; + int encodep, *max_lookup; { - int magnification; + Lisp_Object standard, translation_table; + Lisp_Object val; - if (coding->type == coding_type_ccl) - { - magnification = coding->spec.ccl.encoder.buf_magnification; - if (coding->eol_type == CODING_EOL_CRLF) - magnification *= 2; - } - else if (CODING_REQUIRE_ENCODING (coding)) - magnification = 3; + if (encodep) + translation_table = CODING_ATTR_ENCODE_TBL (attrs), + standard = Vstandard_translation_table_for_encode; + else + translation_table = CODING_ATTR_DECODE_TBL (attrs), + standard = Vstandard_translation_table_for_decode; + if (NILP (translation_table)) + translation_table = standard; else - magnification = 1; - - return (src_bytes * magnification + CONVERSION_BUFFER_EXTRA_ROOM); -} - -/* Working buffer for code conversion. */ -struct conversion_buffer -{ - int size; /* size of data. */ - int on_stack; /* 1 if allocated by alloca. */ - unsigned char *data; -}; - -/* Allocate LEN bytes of memory for BUF (struct conversion_buffer). */ -#define allocate_conversion_buffer(buf, len) \ - do { \ - if (len < MAX_ALLOCA) \ - { \ - buf.data = (unsigned char *) alloca (len); \ - buf.on_stack = 1; \ - } \ - else \ - { \ - buf.data = (unsigned char *) xmalloc (len); \ - buf.on_stack = 0; \ - } \ - buf.size = len; \ - } while (0) - -/* Double the allocated memory for *BUF. */ -static void -extend_conversion_buffer (buf) - struct conversion_buffer *buf; -{ - if (buf->on_stack) { - unsigned char *save = buf->data; - buf->data = (unsigned char *) xmalloc (buf->size * 2); - bcopy (save, buf->data, buf->size); - buf->on_stack = 0; + if (SYMBOLP (translation_table)) + translation_table = Fget (translation_table, Qtranslation_table); + else if (CONSP (translation_table)) + { + translation_table = Fcopy_sequence (translation_table); + for (val = translation_table; CONSP (val); val = XCDR (val)) + if (SYMBOLP (XCAR (val))) + XSETCAR (val, Fget (XCAR (val), Qtranslation_table)); + } + if (CHAR_TABLE_P (standard)) + { + if (CONSP (translation_table)) + translation_table = nconc2 (translation_table, + Fcons (standard, Qnil)); + else + translation_table = Fcons (translation_table, + Fcons (standard, Qnil)); + } } - else + + if (max_lookup) { - buf->data = (unsigned char *) xrealloc (buf->data, buf->size * 2); + *max_lookup = 1; + if (CHAR_TABLE_P (translation_table) + && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (translation_table)) > 1) + { + val = XCHAR_TABLE (translation_table)->extras[1]; + if (NATNUMP (val) && *max_lookup < XFASTINT (val)) + *max_lookup = XFASTINT (val); + } + else if (CONSP (translation_table)) + { + Lisp_Object tail, val; + + for (tail = translation_table; CONSP (tail); tail = XCDR (tail)) + if (CHAR_TABLE_P (XCAR (tail)) + && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (XCAR (tail))) > 1) + { + val = XCHAR_TABLE (XCAR (tail))->extras[1]; + if (NATNUMP (val) && *max_lookup < XFASTINT (val)) + *max_lookup = XFASTINT (val); + } + } } - buf->size *= 2; + return translation_table; } -/* Free the allocated memory for BUF if it is not on stack. */ -static void -free_conversion_buffer (buf) - struct conversion_buffer *buf; -{ - if (!buf->on_stack) - xfree (buf->data); -} +#define LOOKUP_TRANSLATION_TABLE(table, c, trans) \ + do { \ + trans = Qnil; \ + if (CHAR_TABLE_P (table)) \ + { \ + trans = CHAR_TABLE_REF (table, c); \ + if (CHARACTERP (trans)) \ + c = XFASTINT (trans), trans = Qnil; \ + } \ + else if (CONSP (table)) \ + { \ + Lisp_Object tail; \ + \ + for (tail = table; CONSP (tail); tail = XCDR (tail)) \ + if (CHAR_TABLE_P (XCAR (tail))) \ + { \ + trans = CHAR_TABLE_REF (XCAR (tail), c); \ + if (CHARACTERP (trans)) \ + c = XFASTINT (trans), trans = Qnil; \ + else if (! NILP (trans)) \ + break; \ + } \ + } \ + } while (0) -int -ccl_coding_driver (coding, source, destination, src_bytes, dst_bytes, encodep) - struct coding_system *coding; - unsigned char *source, *destination; - int src_bytes, dst_bytes, encodep; -{ - struct ccl_program *ccl - = encodep ? &coding->spec.ccl.encoder : &coding->spec.ccl.decoder; - unsigned char *dst = destination; - ccl->suppress_error = coding->suppress_error; - ccl->last_block = coding->mode & CODING_MODE_LAST_BLOCK; - if (encodep) - { - /* On encoding, EOL format is converted within ccl_driver. For - that, setup proper information in the structure CCL. */ - ccl->eol_type = coding->eol_type; - if (ccl->eol_type ==CODING_EOL_UNDECIDED) - ccl->eol_type = CODING_EOL_LF; - ccl->cr_consumed = coding->spec.ccl.cr_carryover; - ccl->eight_bit_control = coding->dst_multibyte; - } - else - ccl->eight_bit_control = 1; - ccl->multibyte = coding->src_multibyte; - if (coding->spec.ccl.eight_bit_carryover[0] != 0) +static Lisp_Object +get_translation (val, buf, buf_end, last_block, from_nchars, to_nchars) + Lisp_Object val; + int *buf, *buf_end; + int last_block; + int *from_nchars, *to_nchars; +{ + /* VAL is TO or (([FROM-CHAR ...] . TO) ...) where TO is TO-CHAR or + [TO-CHAR ...]. */ + if (CONSP (val)) { - /* Move carryover bytes to DESTINATION. */ - unsigned char *p = coding->spec.ccl.eight_bit_carryover; - while (*p) - *dst++ = *p++; - coding->spec.ccl.eight_bit_carryover[0] = 0; - if (dst_bytes) - dst_bytes -= dst - destination; - } + Lisp_Object from, tail; + int i, len; - coding->produced = (ccl_driver (ccl, source, dst, src_bytes, dst_bytes, - &(coding->consumed)) - + dst - destination); - - if (encodep) - { - coding->produced_char = coding->produced; - coding->spec.ccl.cr_carryover = ccl->cr_consumed; - } - else if (!ccl->eight_bit_control) - { - /* The produced bytes forms a valid multibyte sequence. */ - coding->produced_char - = multibyte_chars_in_text (destination, coding->produced); - coding->spec.ccl.eight_bit_carryover[0] = 0; - } - else - { - /* On decoding, the destination should always multibyte. But, - CCL program might have been generated an invalid multibyte - sequence. Here we make such a sequence valid as - multibyte. */ - int bytes - = dst_bytes ? dst_bytes : source + coding->consumed - destination; - - if ((coding->consumed < src_bytes - || !ccl->last_block) - && coding->produced >= 1 - && destination[coding->produced - 1] >= 0x80) - { - /* We should not convert the tailing 8-bit codes to - multibyte form even if they doesn't form a valid - multibyte sequence. They may form a valid sequence in - the next call. */ - int carryover = 0; - - if (destination[coding->produced - 1] < 0xA0) - carryover = 1; - else if (coding->produced >= 2) + for (tail = val; CONSP (tail); tail = XCDR (tail)) + { + val = XCAR (tail); + from = XCAR (val); + len = ASIZE (from); + for (i = 0; i < len; i++) { - if (destination[coding->produced - 2] >= 0x80) + if (buf + i == buf_end) { - if (destination[coding->produced - 2] < 0xA0) - carryover = 2; - else if (coding->produced >= 3 - && destination[coding->produced - 3] >= 0x80 - && destination[coding->produced - 3] < 0xA0) - carryover = 3; + if (! last_block) + return Qt; + break; } + if (XINT (AREF (from, i)) != buf[i]) + break; } - if (carryover > 0) + if (i == len) { - BCOPY_SHORT (destination + coding->produced - carryover, - coding->spec.ccl.eight_bit_carryover, - carryover); - coding->spec.ccl.eight_bit_carryover[carryover] = 0; - coding->produced -= carryover; + val = XCDR (val); + *from_nchars = len; + break; } } - coding->produced = str_as_multibyte (destination, bytes, - coding->produced, - &(coding->produced_char)); - } - - switch (ccl->status) - { - case CCL_STAT_SUSPEND_BY_SRC: - coding->result = CODING_FINISH_INSUFFICIENT_SRC; - break; - case CCL_STAT_SUSPEND_BY_DST: - coding->result = CODING_FINISH_INSUFFICIENT_DST; - break; - case CCL_STAT_QUIT: - case CCL_STAT_INVALID_CMD: - coding->result = CODING_FINISH_INTERRUPT; - break; - default: - coding->result = CODING_FINISH_NORMAL; - break; + if (! CONSP (tail)) + return Qnil; } - return coding->result; + if (VECTORP (val)) + *buf = XINT (AREF (val, 0)), *to_nchars = ASIZE (val); + else + *buf = XINT (val); + return val; } -/* Decode EOL format of the text at PTR of BYTES length destructively - according to CODING->eol_type. This is called after the CCL - program produced a decoded text at PTR. If we do CRLF->LF - conversion, update CODING->produced and CODING->produced_char. */ -static void -decode_eol_post_ccl (coding, ptr, bytes) +static int +produce_chars (coding, translation_table, last_block) struct coding_system *coding; - unsigned char *ptr; - int bytes; + Lisp_Object translation_table; + int last_block; { - Lisp_Object val, saved_coding_symbol; - unsigned char *pend = ptr + bytes; - int dummy; - - /* Remember the current coding system symbol. We set it back when - an inconsistent EOL is found so that `last-coding-system-used' is - set to the coding system that doesn't specify EOL conversion. */ - saved_coding_symbol = coding->symbol; + unsigned char *dst = coding->destination + coding->produced; + unsigned char *dst_end = coding->destination + coding->dst_bytes; + int produced; + int produced_chars = 0; + int carryover = 0; - coding->spec.ccl.cr_carryover = 0; - if (coding->eol_type == CODING_EOL_UNDECIDED) + if (! coding->chars_at_source) { - /* Here, to avoid the call of setup_coding_system, we directly - call detect_eol_type. */ - coding->eol_type = detect_eol_type (ptr, bytes, &dummy); - if (coding->eol_type == CODING_EOL_INCONSISTENT) - coding->eol_type = CODING_EOL_LF; - if (coding->eol_type != CODING_EOL_UNDECIDED) - { - val = Fget (coding->symbol, Qeol_type); - if (VECTORP (val) && XVECTOR (val)->size == 3) - coding->symbol = XVECTOR (val)->contents[coding->eol_type]; - } - coding->mode |= CODING_MODE_INHIBIT_INCONSISTENT_EOL; - } + /* Characters are in coding->charbuf. */ + int *buf = coding->charbuf; + int *buf_end = buf + coding->charbuf_used; - if (coding->eol_type == CODING_EOL_LF - || coding->eol_type == CODING_EOL_UNDECIDED) - { - /* We have nothing to do. */ - ptr = pend; - } - else if (coding->eol_type == CODING_EOL_CRLF) - { - unsigned char *pstart = ptr, *p = ptr; + if (BUFFERP (coding->src_object) + && EQ (coding->src_object, coding->dst_object)) + dst_end = ((unsigned char *) coding->source) + coding->consumed; - if (! (coding->mode & CODING_MODE_LAST_BLOCK) - && *(pend - 1) == '\r') - { - /* If the last character is CR, we can't handle it here - because LF will be in the not-yet-decoded source text. - Record that the CR is not yet processed. */ - coding->spec.ccl.cr_carryover = 1; - coding->produced--; - coding->produced_char--; - pend--; - } - while (ptr < pend) + while (buf < buf_end) { - if (*ptr == '\r') + int c = *buf, i; + + if (c >= 0) { - if (ptr + 1 < pend && *(ptr + 1) == '\n') + int from_nchars = 1, to_nchars = 1; + Lisp_Object trans = Qnil; + + LOOKUP_TRANSLATION_TABLE (translation_table, c, trans); + if (! NILP (trans)) { - *p++ = '\n'; - ptr += 2; + trans = get_translation (trans, buf, buf_end, last_block, + &from_nchars, &to_nchars); + if (EQ (trans, Qt)) + break; + c = *buf; } - else + + if (dst + MAX_MULTIBYTE_LENGTH * to_nchars > dst_end) { - if (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL) - goto undo_eol_conversion; - *p++ = *ptr++; + dst = alloc_destination (coding, + buf_end - buf + + MAX_MULTIBYTE_LENGTH * to_nchars, + dst); + dst_end = coding->destination + coding->dst_bytes; } - } - else if (*ptr == '\n' - && coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL) - goto undo_eol_conversion; - else - *p++ = *ptr++; - continue; - undo_eol_conversion: - /* We have faced with inconsistent EOL format at PTR. - Convert all LFs before PTR back to CRLFs. */ - for (p--, ptr--; p >= pstart; p--) - { - if (*p == '\n') - *ptr-- = '\n', *ptr-- = '\r'; - else - *ptr-- = *p; - } - /* If carryover is recorded, cancel it because we don't - convert CRLF anymore. */ - if (coding->spec.ccl.cr_carryover) - { - coding->spec.ccl.cr_carryover = 0; - coding->produced++; - coding->produced_char++; - pend++; - } - p = ptr = pend; - coding->eol_type = CODING_EOL_LF; - coding->symbol = saved_coding_symbol; - } - if (p < pend) - { - /* As each two-byte sequence CRLF was converted to LF, (PEND - - P) is the number of deleted characters. */ - coding->produced -= pend - p; - coding->produced_char -= pend - p; - } - } - else /* i.e. coding->eol_type == CODING_EOL_CR */ - { - unsigned char *p = ptr; - - for (; ptr < pend; ptr++) - { - if (*ptr == '\r') - *ptr = '\n'; - else if (*ptr == '\n' - && coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL) - { - for (; p < ptr; p++) + for (i = 0; i < to_nchars; i++) { - if (*p == '\n') - *p = '\r'; + if (i > 0) + c = XINT (AREF (trans, i)); + if (coding->dst_multibyte + || ! CHAR_BYTE8_P (c)) + CHAR_STRING_ADVANCE (c, dst); + else + *dst++ = CHAR_TO_BYTE8 (c); } - ptr = pend; - coding->eol_type = CODING_EOL_LF; - coding->symbol = saved_coding_symbol; + produced_chars += to_nchars; + *buf++ = to_nchars; + while (--from_nchars > 0) + *buf++ = 0; } + else + /* This is an annotation datum. (-C) is the length. */ + buf += -c; } + carryover = buf_end - buf; } -} - -/* See "GENERAL NOTES about `decode_coding_XXX ()' functions". Before - decoding, it may detect coding system and format of end-of-line if - those are not yet decided. The source should be unibyte, the - result is multibyte if CODING->dst_multibyte is nonzero, else - unibyte. */ - -int -decode_coding (coding, source, destination, src_bytes, dst_bytes) - struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; -{ - int extra = 0; - - if (coding->type == coding_type_undecided) - detect_coding (coding, source, src_bytes); - - if (coding->eol_type == CODING_EOL_UNDECIDED - && coding->type != coding_type_ccl) + else { - detect_eol (coding, source, src_bytes); - /* We had better recover the original eol format if we - encounter an inconsistent eol format while decoding. */ - coding->mode |= CODING_MODE_INHIBIT_INCONSISTENT_EOL; - } - - coding->produced = coding->produced_char = 0; - coding->consumed = coding->consumed_char = 0; - coding->errors = 0; - coding->result = CODING_FINISH_NORMAL; + const unsigned char *src = coding->source; + const unsigned char *src_end = src + coding->src_bytes; + Lisp_Object eol_type; - switch (coding->type) - { - case coding_type_sjis: - decode_coding_sjis_big5 (coding, source, destination, - src_bytes, dst_bytes, 1); - break; + eol_type = CODING_ID_EOL_TYPE (coding->id); - case coding_type_iso2022: - decode_coding_iso2022 (coding, source, destination, - src_bytes, dst_bytes); - break; + if (coding->src_multibyte != coding->dst_multibyte) + { + if (coding->src_multibyte) + { + int multibytep = 1; + int consumed_chars; - case coding_type_big5: - decode_coding_sjis_big5 (coding, source, destination, - src_bytes, dst_bytes, 0); - break; + while (1) + { + const unsigned char *src_base = src; + int c; - case coding_type_emacs_mule: - decode_coding_emacs_mule (coding, source, destination, - src_bytes, dst_bytes); - break; + ONE_MORE_BYTE (c); + if (c == '\r') + { + if (EQ (eol_type, Qdos)) + { + if (src == src_end) + { + record_conversion_result + (coding, CODING_RESULT_INSUFFICIENT_SRC); + goto no_more_source; + } + if (*src == '\n') + c = *src++; + } + else if (EQ (eol_type, Qmac)) + c = '\n'; + } + if (dst == dst_end) + { + coding->consumed = src - coding->source; + + if (EQ (coding->src_object, coding->dst_object)) + dst_end = (unsigned char *) src; + if (dst == dst_end) + { + dst = alloc_destination (coding, src_end - src + 1, + dst); + dst_end = coding->destination + coding->dst_bytes; + coding_set_source (coding); + src = coding->source + coding->consumed; + src_end = coding->source + coding->src_bytes; + } + } + *dst++ = c; + produced_chars++; + } + no_more_source: + ; + } + else + while (src < src_end) + { + int multibytep = 1; + int c = *src++; - case coding_type_ccl: - if (coding->spec.ccl.cr_carryover) - { - /* Put the CR which was not processed by the previous call - of decode_eol_post_ccl in DESTINATION. It will be - decoded together with the following LF by the call to - decode_eol_post_ccl below. */ - *destination = '\r'; - coding->produced++; - coding->produced_char++; - dst_bytes--; - extra = coding->spec.ccl.cr_carryover; + if (c == '\r') + { + if (EQ (eol_type, Qdos)) + { + if (src < src_end + && *src == '\n') + c = *src++; + } + else if (EQ (eol_type, Qmac)) + c = '\n'; + } + if (dst >= dst_end - 1) + { + coding->consumed = src - coding->source; + + if (EQ (coding->src_object, coding->dst_object)) + dst_end = (unsigned char *) src; + if (dst >= dst_end - 1) + { + dst = alloc_destination (coding, src_end - src + 2, + dst); + dst_end = coding->destination + coding->dst_bytes; + coding_set_source (coding); + src = coding->source + coding->consumed; + src_end = coding->source + coding->src_bytes; + } + } + EMIT_ONE_BYTE (c); + } } - ccl_coding_driver (coding, source, destination + extra, - src_bytes, dst_bytes, 0); - if (coding->eol_type != CODING_EOL_LF) + else { - coding->produced += extra; - coding->produced_char += extra; - decode_eol_post_ccl (coding, destination, coding->produced); - } - break; - - default: - decode_eol (coding, source, destination, src_bytes, dst_bytes); - } + if (!EQ (coding->src_object, coding->dst_object)) + { + int require = coding->src_bytes - coding->dst_bytes; - if (coding->result == CODING_FINISH_INSUFFICIENT_SRC - && coding->mode & CODING_MODE_LAST_BLOCK - && coding->consumed == src_bytes) - coding->result = CODING_FINISH_NORMAL; + if (require > 0) + { + EMACS_INT offset = src - coding->source; - if (coding->mode & CODING_MODE_LAST_BLOCK - && coding->result == CODING_FINISH_INSUFFICIENT_SRC) - { - const unsigned char *src = source + coding->consumed; - unsigned char *dst = destination + coding->produced; + dst = alloc_destination (coding, require, dst); + coding_set_source (coding); + src = coding->source + offset; + src_end = coding->source + coding->src_bytes; + } + } + produced_chars = coding->src_chars; + while (src < src_end) + { + int c = *src++; - src_bytes -= coding->consumed; - coding->errors++; - if (COMPOSING_P (coding)) - DECODE_COMPOSITION_END ('1'); - while (src_bytes--) - { - int c = *src++; - dst += CHAR_STRING (c, dst); - coding->produced_char++; + if (c == '\r') + { + if (EQ (eol_type, Qdos)) + { + if (src < src_end + && *src == '\n') + c = *src++; + produced_chars--; + } + else if (EQ (eol_type, Qmac)) + c = '\n'; + } + *dst++ = c; + } } - coding->consumed = coding->consumed_char = src - source; - coding->produced = dst - destination; - coding->result = CODING_FINISH_NORMAL; - } - - if (!coding->dst_multibyte) - { - coding->produced = str_as_unibyte (destination, coding->produced); - coding->produced_char = coding->produced; + coding->consumed = coding->src_bytes; + coding->consumed_char = coding->src_chars; } - return coding->result; + produced = dst - (coding->destination + coding->produced); + if (BUFFERP (coding->dst_object) && produced_chars > 0) + insert_from_gap (produced_chars, produced); + coding->produced += produced; + coding->produced_char += produced_chars; + return carryover; } -/* See "GENERAL NOTES about `encode_coding_XXX ()' functions". The - multibyteness of the source is CODING->src_multibyte, the - multibyteness of the result is always unibyte. */ +/* Compose text in CODING->object according to the annotation data at + CHARBUF. CHARBUF is an array: + [ -LENGTH ANNOTATION_MASK FROM TO METHOD COMP_LEN [ COMPONENTS... ] ] + */ -int -encode_coding (coding, source, destination, src_bytes, dst_bytes) +static INLINE void +produce_composition (coding, charbuf, pos) struct coding_system *coding; - const unsigned char *source; - unsigned char *destination; - int src_bytes, dst_bytes; + int *charbuf; + EMACS_INT pos; { - coding->produced = coding->produced_char = 0; - coding->consumed = coding->consumed_char = 0; - coding->errors = 0; - coding->result = CODING_FINISH_NORMAL; - if (coding->eol_type == CODING_EOL_UNDECIDED) - coding->eol_type = CODING_EOL_LF; - - switch (coding->type) - { - case coding_type_sjis: - encode_coding_sjis_big5 (coding, source, destination, - src_bytes, dst_bytes, 1); - break; - - case coding_type_iso2022: - encode_coding_iso2022 (coding, source, destination, - src_bytes, dst_bytes); - break; - - case coding_type_big5: - encode_coding_sjis_big5 (coding, source, destination, - src_bytes, dst_bytes, 0); - break; - - case coding_type_emacs_mule: - encode_coding_emacs_mule (coding, source, destination, - src_bytes, dst_bytes); - break; - - case coding_type_ccl: - ccl_coding_driver (coding, source, destination, - src_bytes, dst_bytes, 1); - break; + int len; + EMACS_INT to; + enum composition_method method; + Lisp_Object components; - default: - encode_eol (coding, source, destination, src_bytes, dst_bytes); - } + len = -charbuf[0]; + to = pos + charbuf[2]; + if (to <= pos) + return; + method = (enum composition_method) (charbuf[3]); - if (coding->mode & CODING_MODE_LAST_BLOCK - && coding->result == CODING_FINISH_INSUFFICIENT_SRC) + if (method == COMPOSITION_RELATIVE) + components = Qnil; + else if (method >= COMPOSITION_WITH_RULE + && method <= COMPOSITION_WITH_RULE_ALTCHARS) { - const unsigned char *src = source + coding->consumed; - unsigned char *dst = destination + coding->produced; + Lisp_Object args[MAX_COMPOSITION_COMPONENTS * 2 - 1]; + int i; - if (coding->type == coding_type_iso2022) - ENCODE_RESET_PLANE_AND_REGISTER; - if (COMPOSING_P (coding)) - *dst++ = ISO_CODE_ESC, *dst++ = '1'; - if (coding->consumed < src_bytes) + len -= 4; + charbuf += 4; + for (i = 0; i < len; i++) { - int len = src_bytes - coding->consumed; - - BCOPY_SHORT (src, dst, len); - if (coding->src_multibyte) - len = str_as_unibyte (dst, len); - dst += len; - coding->consumed = src_bytes; + args[i] = make_number (charbuf[i]); + if (charbuf[i] < 0) + return; } - coding->produced = coding->produced_char = dst - destination; - coding->result = CODING_FINISH_NORMAL; + components = (method == COMPOSITION_WITH_ALTCHARS + ? Fstring (len, args) : Fvector (len, args)); } - - if (coding->result == CODING_FINISH_INSUFFICIENT_SRC - && coding->consumed == src_bytes) - coding->result = CODING_FINISH_NORMAL; - - return coding->result; + else + return; + compose_text (pos, to, components, Qnil, coding->dst_object); } -/* Scan text in the region between *BEG and *END (byte positions), - skip characters which we don't have to decode by coding system - CODING at the head and tail, then set *BEG and *END to the region - of the text we actually have to convert. The caller should move - the gap out of the region in advance if the region is from a - buffer. - If STR is not NULL, *BEG and *END are indices into STR. */ +/* Put `charset' property on text in CODING->object according to + the annotation data at CHARBUF. CHARBUF is an array: + [ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ] + */ -static void -shrink_decoding_region (beg, end, coding, str) - int *beg, *end; +static INLINE void +produce_charset (coding, charbuf, pos) struct coding_system *coding; - unsigned char *str; + int *charbuf; + EMACS_INT pos; { - unsigned char *begp_orig, *begp, *endp_orig, *endp, c; - int eol_conversion; - Lisp_Object translation_table; + EMACS_INT from = pos - charbuf[2]; + struct charset *charset = CHARSET_FROM_ID (charbuf[3]); - if (coding->type == coding_type_ccl - || coding->type == coding_type_undecided - || coding->eol_type != CODING_EOL_LF - || !NILP (coding->post_read_conversion) - || coding->composing != COMPOSITION_DISABLED) - { - /* We can't skip any data. */ - return; - } - if (coding->type == coding_type_no_conversion - || coding->type == coding_type_raw_text - || coding->type == coding_type_emacs_mule) - { - /* We need no conversion, but don't have to skip any data here. - Decoding routine handles them effectively anyway. */ - return; - } + Fput_text_property (make_number (from), make_number (pos), + Qcharset, CHARSET_NAME (charset), + coding->dst_object); +} - translation_table = coding->translation_table_for_decode; - if (NILP (translation_table) && !NILP (Venable_character_translation)) - translation_table = Vstandard_translation_table_for_decode; - if (CHAR_TABLE_P (translation_table)) - { - int i; - for (i = 0; i < 128; i++) - if (!NILP (CHAR_TABLE_REF (translation_table, i))) - break; - if (i < 128) - /* Some ASCII character should be translated. We give up - shrinking. */ - return; - } - if (coding->heading_ascii >= 0) - /* Detection routine has already found how much we can skip at the - head. */ - *beg += coding->heading_ascii; +#define CHARBUF_SIZE 0x4000 - if (str) - { - begp_orig = begp = str + *beg; - endp_orig = endp = str + *end; - } - else - { - begp_orig = begp = BYTE_POS_ADDR (*beg); - endp_orig = endp = begp + *end - *beg; - } +#define ALLOC_CONVERSION_WORK_AREA(coding) \ + do { \ + int size = CHARBUF_SIZE;; \ + \ + coding->charbuf = NULL; \ + while (size > 1024) \ + { \ + coding->charbuf = (int *) alloca (sizeof (int) * size); \ + if (coding->charbuf) \ + break; \ + size >>= 1; \ + } \ + if (! coding->charbuf) \ + { \ + record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_MEM); \ + return coding->result; \ + } \ + coding->charbuf_size = size; \ + } while (0) - eol_conversion = (coding->eol_type == CODING_EOL_CR - || coding->eol_type == CODING_EOL_CRLF); - switch (coding->type) +static void +produce_annotation (coding, pos) + struct coding_system *coding; + EMACS_INT pos; +{ + int *charbuf = coding->charbuf; + int *charbuf_end = charbuf + coding->charbuf_used; + + if (NILP (coding->dst_object)) + return; + + while (charbuf < charbuf_end) { - case coding_type_sjis: - case coding_type_big5: - /* We can skip all ASCII characters at the head. */ - if (coding->heading_ascii < 0) + if (*charbuf >= 0) + pos += *charbuf++; + else { - if (eol_conversion) - while (begp < endp && *begp < 0x80 && *begp != '\r') begp++; - else - while (begp < endp && *begp < 0x80) begp++; + int len = -*charbuf; + switch (charbuf[1]) + { + case CODING_ANNOTATE_COMPOSITION_MASK: + produce_composition (coding, charbuf, pos); + break; + case CODING_ANNOTATE_CHARSET_MASK: + produce_charset (coding, charbuf, pos); + break; + default: + abort (); + } + charbuf += len; } - /* We can skip all ASCII characters at the tail except for the - second byte of SJIS or BIG5 code. */ - if (eol_conversion) - while (begp < endp && endp[-1] < 0x80 && endp[-1] != '\r') endp--; - else - while (begp < endp && endp[-1] < 0x80) endp--; - /* Do not consider LF as ascii if preceded by CR, since that - confuses eol decoding. */ - if (begp < endp && endp < endp_orig && endp[-1] == '\r' && endp[0] == '\n') - endp++; - if (begp < endp && endp < endp_orig && endp[-1] >= 0x80) - endp++; - break; + } +} - case coding_type_iso2022: - if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, 0) != CHARSET_ASCII) - /* We can't skip any data. */ - break; - if (coding->heading_ascii < 0) - { - /* We can skip all ASCII characters at the head except for a - few control codes. */ - while (begp < endp && (c = *begp) < 0x80 - && c != ISO_CODE_CR && c != ISO_CODE_SO - && c != ISO_CODE_SI && c != ISO_CODE_ESC - && (!eol_conversion || c != ISO_CODE_LF)) - begp++; - } - switch (coding->category_idx) - { - case CODING_CATEGORY_IDX_ISO_8_1: - case CODING_CATEGORY_IDX_ISO_8_2: - /* We can skip all ASCII characters at the tail. */ - if (eol_conversion) - while (begp < endp && (c = endp[-1]) < 0x80 && c != '\r') endp--; - else - while (begp < endp && endp[-1] < 0x80) endp--; - /* Do not consider LF as ascii if preceded by CR, since that - confuses eol decoding. */ - if (begp < endp && endp < endp_orig && endp[-1] == '\r' && endp[0] == '\n') - endp++; - break; +/* Decode the data at CODING->src_object into CODING->dst_object. + CODING->src_object is a buffer, a string, or nil. + CODING->dst_object is a buffer. - case CODING_CATEGORY_IDX_ISO_7: - case CODING_CATEGORY_IDX_ISO_7_TIGHT: - { - /* We can skip all characters at the tail except for 8-bit - codes and ESC and the following 2-byte at the tail. */ - unsigned char *eight_bit = NULL; + If CODING->src_object is a buffer, it must be the current buffer. + In this case, if CODING->src_pos is positive, it is a position of + the source text in the buffer, otherwise, the source text is in the + gap area of the buffer, and CODING->src_pos specifies the offset of + the text from GPT (which must be the same as PT). If this is the + same buffer as CODING->dst_object, CODING->src_pos must be + negative. - if (eol_conversion) - while (begp < endp - && (c = endp[-1]) != ISO_CODE_ESC && c != '\r') - { - if (!eight_bit && c & 0x80) eight_bit = endp; - endp--; - } - else - while (begp < endp - && (c = endp[-1]) != ISO_CODE_ESC) - { - if (!eight_bit && c & 0x80) eight_bit = endp; - endp--; - } - /* Do not consider LF as ascii if preceded by CR, since that - confuses eol decoding. */ - if (begp < endp && endp < endp_orig - && endp[-1] == '\r' && endp[0] == '\n') - endp++; - if (begp < endp && endp[-1] == ISO_CODE_ESC) - { - if (endp + 1 < endp_orig && end[0] == '(' && end[1] == 'B') - /* This is an ASCII designation sequence. We can - surely skip the tail. But, if we have - encountered an 8-bit code, skip only the codes - after that. */ - endp = eight_bit ? eight_bit : endp + 2; - else - /* Hmmm, we can't skip the tail. */ - endp = endp_orig; - } - else if (eight_bit) - endp = eight_bit; - } - } - break; + If CODING->src_object is a string, CODING->src_pos is an index to + that string. - default: - abort (); - } - *beg += begp - begp_orig; - *end += endp - endp_orig; - return; -} + If CODING->src_object is nil, CODING->source must already point to + the non-relocatable memory area. In this case, CODING->src_pos is + an offset from CODING->source. -/* Like shrink_decoding_region but for encoding. */ + The decoded data is inserted at the current point of the buffer + CODING->dst_object. +*/ -static void -shrink_encoding_region (beg, end, coding, str) - int *beg, *end; +static int +decode_coding (coding) struct coding_system *coding; - unsigned char *str; { - unsigned char *begp_orig, *begp, *endp_orig, *endp; - int eol_conversion; + Lisp_Object attrs; + Lisp_Object undo_list; Lisp_Object translation_table; + int carryover; + int i; - if (coding->type == coding_type_ccl - || coding->eol_type == CODING_EOL_CRLF - || coding->eol_type == CODING_EOL_CR - || (coding->cmp_data && coding->cmp_data->used > 0)) - { - /* We can't skip any data. */ - return; - } - if (coding->type == coding_type_no_conversion - || coding->type == coding_type_raw_text - || coding->type == coding_type_emacs_mule - || coding->type == coding_type_undecided) + if (BUFFERP (coding->src_object) + && coding->src_pos > 0 + && coding->src_pos < GPT + && coding->src_pos + coding->src_chars > GPT) + move_gap_both (coding->src_pos, coding->src_pos_byte); + + undo_list = Qt; + if (BUFFERP (coding->dst_object)) { - /* We need no conversion, but don't have to skip any data here. - Encoding routine handles them effectively anyway. */ - return; + if (current_buffer != XBUFFER (coding->dst_object)) + set_buffer_internal (XBUFFER (coding->dst_object)); + if (GPT != PT) + move_gap_both (PT, PT_BYTE); + undo_list = current_buffer->undo_list; + current_buffer->undo_list = Qt; } - translation_table = coding->translation_table_for_encode; - if (NILP (translation_table) && !NILP (Venable_character_translation)) - translation_table = Vstandard_translation_table_for_encode; - if (CHAR_TABLE_P (translation_table)) + coding->consumed = coding->consumed_char = 0; + coding->produced = coding->produced_char = 0; + coding->chars_at_source = 0; + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->errors = 0; + + ALLOC_CONVERSION_WORK_AREA (coding); + + attrs = CODING_ID_ATTRS (coding->id); + translation_table = get_translation_table (attrs, 0, NULL); + + carryover = 0; + do { - int i; - for (i = 0; i < 128; i++) - if (!NILP (CHAR_TABLE_REF (translation_table, i))) - break; - if (i < 128) - /* Some ASCII character should be translated. We give up - shrinking. */ - return; + EMACS_INT pos = coding->dst_pos + coding->produced_char; + + coding_set_source (coding); + coding->annotated = 0; + coding->charbuf_used = carryover; + (*(coding->decoder)) (coding); + coding_set_destination (coding); + carryover = produce_chars (coding, translation_table, 0); + if (coding->annotated) + produce_annotation (coding, pos); + for (i = 0; i < carryover; i++) + coding->charbuf[i] + = coding->charbuf[coding->charbuf_used - carryover + i]; } + while (coding->consumed < coding->src_bytes + && (coding->result == CODING_RESULT_SUCCESS + || coding->result == CODING_RESULT_INVALID_SRC)); - if (str) + if (carryover > 0) { - begp_orig = begp = str + *beg; - endp_orig = endp = str + *end; + coding_set_destination (coding); + coding->charbuf_used = carryover; + produce_chars (coding, translation_table, 1); } - else + + coding->carryover_bytes = 0; + if (coding->consumed < coding->src_bytes) { - begp_orig = begp = BYTE_POS_ADDR (*beg); - endp_orig = endp = begp + *end - *beg; - } + int nbytes = coding->src_bytes - coding->consumed; + const unsigned char *src; - eol_conversion = (coding->eol_type == CODING_EOL_CR - || coding->eol_type == CODING_EOL_CRLF); + coding_set_source (coding); + coding_set_destination (coding); + src = coding->source + coding->consumed; - /* Here, we don't have to check coding->pre_write_conversion because - the caller is expected to have handled it already. */ - switch (coding->type) - { - case coding_type_iso2022: - if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, 0) != CHARSET_ASCII) - /* We can't skip any data. */ - break; - if (coding->flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL) + if (coding->mode & CODING_MODE_LAST_BLOCK) { - unsigned char *bol = begp; - while (begp < endp && *begp < 0x80) + /* Flush out unprocessed data as binary chars. We are sure + that the number of data is less than the size of + coding->charbuf. */ + coding->charbuf_used = 0; + while (nbytes-- > 0) { - begp++; - if (begp[-1] == '\n') - bol = begp; + int c = *src++; + + if (c & 0x80) + c = BYTE8_TO_CHAR (c); + coding->charbuf[coding->charbuf_used++] = c; } - begp = bol; - goto label_skip_tail; + produce_chars (coding, Qnil, 1); } - /* fall down ... */ - - case coding_type_sjis: - case coding_type_big5: - /* We can skip all ASCII characters at the head and tail. */ - if (eol_conversion) - while (begp < endp && *begp < 0x80 && *begp != '\n') begp++; - else - while (begp < endp && *begp < 0x80) begp++; - label_skip_tail: - if (eol_conversion) - while (begp < endp && endp[-1] < 0x80 && endp[-1] != '\n') endp--; else - while (begp < endp && *(endp - 1) < 0x80) endp--; - break; - - default: - abort (); + { + /* Record unprocessed bytes in coding->carryover. We are + sure that the number of data is less than the size of + coding->carryover. */ + unsigned char *p = coding->carryover; + + coding->carryover_bytes = nbytes; + while (nbytes-- > 0) + *p++ = *src++; + } + coding->consumed = coding->src_bytes; } - *beg += begp - begp_orig; - *end += endp - endp_orig; - return; + if (! EQ (CODING_ID_EOL_TYPE (coding->id), Qunix)) + decode_eol (coding); + if (BUFFERP (coding->dst_object)) + { + current_buffer->undo_list = undo_list; + record_insert (coding->dst_pos, coding->produced_char); + } + return coding->result; } -/* As shrinking conversion region requires some overhead, we don't try - shrinking if the length of conversion region is less than this - value. */ -static int shrink_conversion_region_threshhold = 1024; -#define SHRINK_CONVERSION_REGION(beg, end, coding, str, encodep) \ - do { \ - if (*(end) - *(beg) > shrink_conversion_region_threshhold) \ - { \ - if (encodep) shrink_encoding_region (beg, end, coding, str); \ - else shrink_decoding_region (beg, end, coding, str); \ - } \ - } while (0) - -/* ARG is (CODING BUFFER ...) where CODING is what to be set in - Vlast_coding_system_used and the remaining elements are buffers to - kill. */ -static Lisp_Object -code_convert_region_unwind (arg) - Lisp_Object arg; -{ - struct gcpro gcpro1; - GCPRO1 (arg); +/* Extract an annotation datum from a composition starting at POS and + ending before LIMIT of CODING->src_object (buffer or string), store + the data in BUF, set *STOP to a starting position of the next + composition (if any) or to LIMIT, and return the address of the + next element of BUF. - inhibit_pre_post_conversion = 0; - Vlast_coding_system_used = XCAR (arg); - for (arg = XCDR (arg); CONSP (arg); arg = XCDR (arg)) - Fkill_buffer (XCAR (arg)); + If such an annotation is not found, set *STOP to a starting + position of a composition after POS (if any) or to LIMIT, and + return BUF. */ - UNGCPRO; - return Qnil; -} - -/* Store information about all compositions in the range FROM and TO - of OBJ in memory blocks pointed by CODING->cmp_data. OBJ is a - buffer or a string, defaults to the current buffer. */ - -void -coding_save_composition (coding, from, to, obj) +static INLINE int * +handle_composition_annotation (pos, limit, coding, buf, stop) + EMACS_INT pos, limit; struct coding_system *coding; - int from, to; - Lisp_Object obj; + int *buf; + EMACS_INT *stop; { + EMACS_INT start, end; Lisp_Object prop; - int start, end; - if (coding->composing == COMPOSITION_DISABLED) - return; - if (!coding->cmp_data) - coding_allocate_composition_data (coding, from); - if (!find_composition (from, to, &start, &end, &prop, obj) - || end > to) - return; - if (start < from - && (!find_composition (end, to, &start, &end, &prop, obj) - || end > to)) - return; - coding->composing = COMPOSITION_NO; - do + if (! find_composition (pos, limit, &start, &end, &prop, coding->src_object) + || end > limit) + *stop = limit; + else if (start > pos) + *stop = start; + else { - if (COMPOSITION_VALID_P (start, end, prop)) + if (start == pos) { + /* We found a composition. Store the corresponding + annotation data in BUF. */ + int *head = buf; enum composition_method method = COMPOSITION_METHOD (prop); - if (coding->cmp_data->used + COMPOSITION_DATA_MAX_BUNCH_LENGTH - >= COMPOSITION_DATA_SIZE) - coding_allocate_composition_data (coding, from); - /* For relative composition, we remember start and end - positions, for the other compositions, we also remember - components. */ - CODING_ADD_COMPOSITION_START (coding, start - from, method); + int nchars = COMPOSITION_LENGTH (prop); + + ADD_COMPOSITION_DATA (buf, nchars, method); if (method != COMPOSITION_RELATIVE) { - /* We must store a*/ - Lisp_Object val, ch; + Lisp_Object components; + int len, i, i_byte; - val = COMPOSITION_COMPONENTS (prop); - if (CONSP (val)) - while (CONSP (val)) - { - ch = XCAR (val), val = XCDR (val); - CODING_ADD_COMPOSITION_COMPONENT (coding, XINT (ch)); - } - else if (VECTORP (val) || STRINGP (val)) + components = COMPOSITION_COMPONENTS (prop); + if (VECTORP (components)) { - int len = (VECTORP (val) - ? XVECTOR (val)->size : SCHARS (val)); - int i; + len = XVECTOR (components)->size; for (i = 0; i < len; i++) + *buf++ = XINT (AREF (components, i)); + } + else if (STRINGP (components)) + { + len = SCHARS (components); + i = i_byte = 0; + while (i < len) { - ch = (STRINGP (val) - ? Faref (val, make_number (i)) - : XVECTOR (val)->contents[i]); - CODING_ADD_COMPOSITION_COMPONENT (coding, XINT (ch)); + FETCH_STRING_CHAR_ADVANCE (*buf, components, i, i_byte); + buf++; } } - else /* INTEGERP (val) */ - CODING_ADD_COMPOSITION_COMPONENT (coding, XINT (val)); + else if (INTEGERP (components)) + { + len = 1; + *buf++ = XINT (components); + } + else if (CONSP (components)) + { + for (len = 0; CONSP (components); + len++, components = XCDR (components)) + *buf++ = XINT (XCAR (components)); + } + else + abort (); + *head -= len; } - CODING_ADD_COMPOSITION_END (coding, end - from); } - start = end; - } - while (start < to - && find_composition (start, to, &start, &end, &prop, obj) - && end <= to); - /* Make coding->cmp_data point to the first memory block. */ - while (coding->cmp_data->prev) - coding->cmp_data = coding->cmp_data->prev; - coding->cmp_data_start = 0; + if (find_composition (end, limit, &start, &end, &prop, + coding->src_object) + && end <= limit) + *stop = start; + else + *stop = limit; + } + return buf; } -/* Reflect the saved information about compositions to OBJ. - CODING->cmp_data points to a memory block for the information. OBJ - is a buffer or a string, defaults to the current buffer. */ - -void -coding_restore_composition (coding, obj) - struct coding_system *coding; - Lisp_Object obj; -{ - struct composition_data *cmp_data = coding->cmp_data; - - if (!cmp_data) - return; - - while (cmp_data->prev) - cmp_data = cmp_data->prev; - while (cmp_data) - { - int i; +/* Extract an annotation datum from a text property `charset' at POS of + CODING->src_object (buffer of string), store the data in BUF, set + *STOP to the position where the value of `charset' property changes + (limiting by LIMIT), and return the address of the next element of + BUF. - for (i = 0; i < cmp_data->used && cmp_data->data[i] > 0; - i += cmp_data->data[i]) - { - int *data = cmp_data->data + i; - enum composition_method method = (enum composition_method) data[3]; - Lisp_Object components; + If the property value is nil, set *STOP to the position where the + property value is non-nil (limiting by LIMIT), and return BUF. */ - if (data[0] < 0 || i + data[0] > cmp_data->used) - /* Invalid composition data. */ - break; +static INLINE int * +handle_charset_annotation (pos, limit, coding, buf, stop) + EMACS_INT pos, limit; + struct coding_system *coding; + int *buf; + EMACS_INT *stop; +{ + Lisp_Object val, next; + int id; - if (method == COMPOSITION_RELATIVE) - components = Qnil; - else - { - int len = data[0] - 4, j; - Lisp_Object args[MAX_COMPOSITION_COMPONENTS * 2 - 1]; - - if (method == COMPOSITION_WITH_RULE_ALTCHARS - && len % 2 == 0) - len --; - if (len < 1) - /* Invalid composition data. */ - break; - for (j = 0; j < len; j++) - args[j] = make_number (data[4 + j]); - components = (method == COMPOSITION_WITH_ALTCHARS - ? Fstring (len, args) - : Fvector (len, args)); - } - compose_text (data[1], data[2], components, Qnil, obj); - } - cmp_data = cmp_data->next; - } + val = Fget_text_property (make_number (pos), Qcharset, coding->src_object); + if (! NILP (val) && CHARSETP (val)) + id = XINT (CHARSET_SYMBOL_ID (val)); + else + id = -1; + ADD_CHARSET_DATA (buf, 0, id); + next = Fnext_single_property_change (make_number (pos), Qcharset, + coding->src_object, + make_number (limit)); + *stop = XINT (next); + return buf; } -/* Decode (if ENCODEP is zero) or encode (if ENCODEP is nonzero) the - text from FROM to TO (byte positions are FROM_BYTE and TO_BYTE) by - coding system CODING, and return the status code of code conversion - (currently, this value has no meaning). - How many characters (and bytes) are converted to how many - characters (and bytes) are recorded in members of the structure - CODING. - - If REPLACE is nonzero, we do various things as if the original text - is deleted and a new text is inserted. See the comments in - replace_range (insdel.c) to know what we are doing. - - If REPLACE is zero, it is assumed that the source text is unibyte. - Otherwise, it is assumed that the source text is multibyte. */ - -int -code_convert_region (from, from_byte, to, to_byte, coding, encodep, replace) - int from, from_byte, to, to_byte, encodep, replace; +static void +consume_chars (coding, translation_table, max_lookup) struct coding_system *coding; + Lisp_Object translation_table; + int max_lookup; { - int len = to - from, len_byte = to_byte - from_byte; - int nchars_del = 0, nbytes_del = 0; - int require, inserted, inserted_byte; - int head_skip, tail_skip, total_skip = 0; - Lisp_Object saved_coding_symbol; - int first = 1; - unsigned char *src, *dst; - Lisp_Object deletion; - int orig_point = PT, orig_len = len; - int prev_Z; - int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); + int *buf = coding->charbuf; + int *buf_end = coding->charbuf + coding->charbuf_size; + const unsigned char *src = coding->source + coding->consumed; + const unsigned char *src_end = coding->source + coding->src_bytes; + EMACS_INT pos = coding->src_pos + coding->consumed_char; + EMACS_INT end_pos = coding->src_pos + coding->src_chars; + int multibytep = coding->src_multibyte; + Lisp_Object eol_type; + int c; + EMACS_INT stop, stop_composition, stop_charset; + int *lookup_buf = NULL; + + if (! NILP (translation_table)) + lookup_buf = alloca (sizeof (int) * max_lookup); + + eol_type = CODING_ID_EOL_TYPE (coding->id); + if (VECTORP (eol_type)) + eol_type = Qunix; - deletion = Qnil; - saved_coding_symbol = coding->symbol; + /* Note: composition handling is not yet implemented. */ + coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK; - if (from < PT && PT < to) + if (NILP (coding->src_object)) + stop = stop_composition = stop_charset = end_pos; + else { - TEMP_SET_PT_BOTH (from, from_byte); - orig_point = from; + if (coding->common_flags & CODING_ANNOTATE_COMPOSITION_MASK) + stop = stop_composition = pos; + else + stop = stop_composition = end_pos; + if (coding->common_flags & CODING_ANNOTATE_CHARSET_MASK) + stop = stop_charset = pos; + else + stop_charset = end_pos; } - if (replace) + /* Compensate for CRLF and conversion. */ + buf_end -= 1 + MAX_ANNOTATION_LENGTH; + while (buf < buf_end) { - int saved_from = from; - int saved_inhibit_modification_hooks; + Lisp_Object trans; - prepare_to_modify_buffer (from, to, &from); - if (saved_from != from) + if (pos == stop) { - to = from + len; - from_byte = CHAR_TO_BYTE (from), to_byte = CHAR_TO_BYTE (to); - len_byte = to_byte - from_byte; + if (pos == end_pos) + break; + if (pos == stop_composition) + buf = handle_composition_annotation (pos, end_pos, coding, + buf, &stop_composition); + if (pos == stop_charset) + buf = handle_charset_annotation (pos, end_pos, coding, + buf, &stop_charset); + stop = (stop_composition < stop_charset + ? stop_composition : stop_charset); } - /* The code conversion routine can not preserve text properties - for now. So, we must remove all text properties in the - region. Here, we must suppress all modification hooks. */ - saved_inhibit_modification_hooks = inhibit_modification_hooks; - inhibit_modification_hooks = 1; - Fset_text_properties (make_number (from), make_number (to), Qnil, Qnil); - inhibit_modification_hooks = saved_inhibit_modification_hooks; - } - - coding->heading_ascii = 0; - - if (! encodep && CODING_REQUIRE_DETECTION (coding)) - { - /* We must detect encoding of text and eol format. */ + if (! multibytep) + { + EMACS_INT bytes; - if (from < GPT && to > GPT) - move_gap_both (from, from_byte); - if (coding->type == coding_type_undecided) + if (coding->encoder == encode_coding_raw_text) + c = *src++, pos++; + else if ((bytes = MULTIBYTE_LENGTH (src, src_end)) > 0) + c = STRING_CHAR_ADVANCE (src), pos += bytes; + else + c = BYTE8_TO_CHAR (*src), src++, pos++; + } + else + c = STRING_CHAR_ADVANCE (src), pos++; + if ((c == '\r') && (coding->mode & CODING_MODE_SELECTIVE_DISPLAY)) + c = '\n'; + if (! EQ (eol_type, Qunix)) { - detect_coding (coding, BYTE_POS_ADDR (from_byte), len_byte); - if (coding->type == coding_type_undecided) + if (c == '\n') { - /* It seems that the text contains only ASCII, but we - should not leave it undecided because the deeper - decoding routine (decode_coding) tries to detect the - encodings again in vain. */ - coding->type = coding_type_emacs_mule; - coding->category_idx = CODING_CATEGORY_IDX_EMACS_MULE; - /* As emacs-mule decoder will handle composition, we - need this setting to allocate coding->cmp_data - later. */ - coding->composing = COMPOSITION_NO; + if (EQ (eol_type, Qdos)) + *buf++ = '\r'; + else + c = '\r'; } } - if (coding->eol_type == CODING_EOL_UNDECIDED - && coding->type != coding_type_ccl) + + trans = Qnil; + LOOKUP_TRANSLATION_TABLE (translation_table, c, trans); + if (NILP (trans)) + *buf++ = c; + else { - detect_eol (coding, BYTE_POS_ADDR (from_byte), len_byte); - if (coding->eol_type == CODING_EOL_UNDECIDED) - coding->eol_type = CODING_EOL_LF; - /* We had better recover the original eol format if we - encounter an inconsistent eol format while decoding. */ - coding->mode |= CODING_MODE_INHIBIT_INCONSISTENT_EOL; + int from_nchars = 1, to_nchars = 1; + int *lookup_buf_end; + const unsigned char *p = src; + int i; + + lookup_buf[0] = c; + for (i = 1; i < max_lookup && p < src_end; i++) + lookup_buf[i] = STRING_CHAR_ADVANCE (p); + lookup_buf_end = lookup_buf + i; + trans = get_translation (trans, lookup_buf, lookup_buf_end, 1, + &from_nchars, &to_nchars); + if (EQ (trans, Qt) + || buf + to_nchars > buf_end) + break; + *buf++ = *lookup_buf; + for (i = 1; i < to_nchars; i++) + *buf++ = XINT (AREF (trans, i)); + for (i = 1; i < from_nchars; i++, pos++) + src += MULTIBYTE_LENGTH_NO_CHECK (src); } } - /* Now we convert the text. */ + coding->consumed = src - coding->source; + coding->consumed_char = pos - coding->src_pos; + coding->charbuf_used = buf - coding->charbuf; + coding->chars_at_source = 0; +} - /* For encoding, we must process pre-write-conversion in advance. */ - if (! inhibit_pre_post_conversion - && encodep - && SYMBOLP (coding->pre_write_conversion) - && ! NILP (Ffboundp (coding->pre_write_conversion))) - { - /* The function in pre-write-conversion may put a new text in a - new buffer. */ - struct buffer *prev = current_buffer; - Lisp_Object new; - record_unwind_protect (code_convert_region_unwind, - Fcons (Vlast_coding_system_used, Qnil)); - /* We should not call any more pre-write/post-read-conversion - functions while this pre-write-conversion is running. */ - inhibit_pre_post_conversion = 1; - call2 (coding->pre_write_conversion, - make_number (from), make_number (to)); - inhibit_pre_post_conversion = 0; - /* Discard the unwind protect. */ - specpdl_ptr--; +/* Encode the text at CODING->src_object into CODING->dst_object. + CODING->src_object is a buffer or a string. + CODING->dst_object is a buffer or nil. - if (current_buffer != prev) - { - len = ZV - BEGV; - new = Fcurrent_buffer (); - set_buffer_internal_1 (prev); - del_range_2 (from, from_byte, to, to_byte, 0); - TEMP_SET_PT_BOTH (from, from_byte); - insert_from_buffer (XBUFFER (new), 1, len, 0); - Fkill_buffer (new); - if (orig_point >= to) - orig_point += len - orig_len; - else if (orig_point > from) - orig_point = from; - orig_len = len; - to = from + len; - from_byte = CHAR_TO_BYTE (from); - to_byte = CHAR_TO_BYTE (to); - len_byte = to_byte - from_byte; - TEMP_SET_PT_BOTH (from, from_byte); - } - } + If CODING->src_object is a buffer, it must be the current buffer. + In this case, if CODING->src_pos is positive, it is a position of + the source text in the buffer, otherwise. the source text is in the + gap area of the buffer, and coding->src_pos specifies the offset of + the text from GPT (which must be the same as PT). If this is the + same buffer as CODING->dst_object, CODING->src_pos must be + negative and CODING should not have `pre-write-conversion'. - if (replace) - { - if (! EQ (current_buffer->undo_list, Qt)) - deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); - else - { - nchars_del = to - from; - nbytes_del = to_byte - from_byte; - } - } + If CODING->src_object is a string, CODING should not have + `pre-write-conversion'. - if (coding->composing != COMPOSITION_DISABLED) - { - if (encodep) - coding_save_composition (coding, from, to, Fcurrent_buffer ()); - else - coding_allocate_composition_data (coding, from); - } - - /* Try to skip the heading and tailing ASCIIs. We can't skip them - if we must run CCL program or there are compositions to - encode. */ - if (coding->type != coding_type_ccl - && (! coding->cmp_data || coding->cmp_data->used == 0)) - { - int from_byte_orig = from_byte, to_byte_orig = to_byte; - - if (from < GPT && GPT < to) - move_gap_both (from, from_byte); - SHRINK_CONVERSION_REGION (&from_byte, &to_byte, coding, NULL, encodep); - if (from_byte == to_byte - && (encodep || NILP (coding->post_read_conversion)) - && ! CODING_REQUIRE_FLUSHING (coding)) - { - coding->produced = len_byte; - coding->produced_char = len; - if (!replace) - /* We must record and adjust for this new text now. */ - adjust_after_insert (from, from_byte_orig, to, to_byte_orig, len); - coding_free_composition_data (coding); - return 0; - } - - head_skip = from_byte - from_byte_orig; - tail_skip = to_byte_orig - to_byte; - total_skip = head_skip + tail_skip; - from += head_skip; - to -= tail_skip; - len -= total_skip; len_byte -= total_skip; - } - - /* For conversion, we must put the gap before the text in addition to - making the gap larger for efficient decoding. The required gap - size starts from 2000 which is the magic number used in make_gap. - But, after one batch of conversion, it will be incremented if we - find that it is not enough . */ - require = 2000; - - if (GAP_SIZE < require) - make_gap (require - GAP_SIZE); - move_gap_both (from, from_byte); - - inserted = inserted_byte = 0; - - GAP_SIZE += len_byte; - ZV -= len; - Z -= len; - ZV_BYTE -= len_byte; - Z_BYTE -= len_byte; - - if (GPT - BEG < BEG_UNCHANGED) - BEG_UNCHANGED = GPT - BEG; - if (Z - GPT < END_UNCHANGED) - END_UNCHANGED = Z - GPT; - - if (!encodep && coding->src_multibyte) - { - /* Decoding routines expects that the source text is unibyte. - We must convert 8-bit characters of multibyte form to - unibyte. */ - int len_byte_orig = len_byte; - len_byte = str_as_unibyte (GAP_END_ADDR - len_byte, len_byte); - if (len_byte < len_byte_orig) - safe_bcopy (GAP_END_ADDR - len_byte_orig, GAP_END_ADDR - len_byte, - len_byte); - coding->src_multibyte = 0; - } - - for (;;) - { - int result; - - /* The buffer memory is now: - +--------+converted-text+---------+-------original-text-------+---+ - |<-from->|<--inserted-->|---------|<--------len_byte--------->|---| - |<---------------------- GAP ----------------------->| */ - src = GAP_END_ADDR - len_byte; - dst = GPT_ADDR + inserted_byte; - - if (encodep) - result = encode_coding (coding, src, dst, len_byte, 0); - else - { - if (coding->composing != COMPOSITION_DISABLED) - coding->cmp_data->char_offset = from + inserted; - result = decode_coding (coding, src, dst, len_byte, 0); - } + If CODING->dst_object is a buffer, the encoded data is inserted at + the current point of that buffer. - /* The buffer memory is now: - +--------+-------converted-text----+--+------original-text----+---+ - |<-from->|<-inserted->|<-produced->|--|<-(len_byte-consumed)->|---| - |<---------------------- GAP ----------------------->| */ + If CODING->dst_object is nil, the encoded data is placed at the + memory area specified by CODING->destination. */ - inserted += coding->produced_char; - inserted_byte += coding->produced; - len_byte -= coding->consumed; +static int +encode_coding (coding) + struct coding_system *coding; +{ + Lisp_Object attrs; + Lisp_Object translation_table; + int max_lookup; - if (result == CODING_FINISH_INSUFFICIENT_CMP) - { - coding_allocate_composition_data (coding, from + inserted); - continue; - } + attrs = CODING_ID_ATTRS (coding->id); + if (coding->encoder == encode_coding_raw_text) + translation_table = Qnil, max_lookup = 0; + else + translation_table = get_translation_table (attrs, 1, &max_lookup); - src += coding->consumed; - dst += coding->produced; + if (BUFFERP (coding->dst_object)) + { + set_buffer_internal (XBUFFER (coding->dst_object)); + coding->dst_multibyte + = ! NILP (current_buffer->enable_multibyte_characters); + } - if (result == CODING_FINISH_NORMAL) - { - src += len_byte; - break; - } - if (! encodep && result == CODING_FINISH_INCONSISTENT_EOL) - { - unsigned char *pend = dst, *p = pend - inserted_byte; - Lisp_Object eol_type; + coding->consumed = coding->consumed_char = 0; + coding->produced = coding->produced_char = 0; + record_conversion_result (coding, CODING_RESULT_SUCCESS); + coding->errors = 0; - /* Encode LFs back to the original eol format (CR or CRLF). */ - if (coding->eol_type == CODING_EOL_CR) - { - while (p < pend) if (*p++ == '\n') p[-1] = '\r'; - } - else - { - int count = 0; + ALLOC_CONVERSION_WORK_AREA (coding); - while (p < pend) if (*p++ == '\n') count++; - if (src - dst < count) - { - /* We don't have sufficient room for encoding LFs - back to CRLF. We must record converted and - not-yet-converted text back to the buffer - content, enlarge the gap, then record them out of - the buffer contents again. */ - int add = len_byte + inserted_byte; - - GAP_SIZE -= add; - ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add; - GPT += inserted_byte; GPT_BYTE += inserted_byte; - make_gap (count - GAP_SIZE); - GAP_SIZE += add; - ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add; - GPT -= inserted_byte; GPT_BYTE -= inserted_byte; - /* Don't forget to update SRC, DST, and PEND. */ - src = GAP_END_ADDR - len_byte; - dst = GPT_ADDR + inserted_byte; - pend = dst; - } - inserted += count; - inserted_byte += count; - coding->produced += count; - p = dst = pend + count; - while (count) - { - *--p = *--pend; - if (*p == '\n') count--, *--p = '\r'; - } - } + do { + coding_set_source (coding); + consume_chars (coding, translation_table, max_lookup); + coding_set_destination (coding); + (*(coding->encoder)) (coding); + } while (coding->consumed_char < coding->src_chars); - /* Suppress eol-format conversion in the further conversion. */ - coding->eol_type = CODING_EOL_LF; + if (BUFFERP (coding->dst_object) && coding->produced_char > 0) + insert_from_gap (coding->produced_char, coding->produced); - /* Set the coding system symbol to that for Unix-like EOL. */ - eol_type = Fget (saved_coding_symbol, Qeol_type); - if (VECTORP (eol_type) - && XVECTOR (eol_type)->size == 3 - && SYMBOLP (XVECTOR (eol_type)->contents[CODING_EOL_LF])) - coding->symbol = XVECTOR (eol_type)->contents[CODING_EOL_LF]; - else - coding->symbol = saved_coding_symbol; + return (coding->result); +} - continue; - } - if (len_byte <= 0) - { - if (coding->type != coding_type_ccl - || coding->mode & CODING_MODE_LAST_BLOCK) - break; - coding->mode |= CODING_MODE_LAST_BLOCK; - continue; - } - if (result == CODING_FINISH_INSUFFICIENT_SRC) - { - /* The source text ends in invalid codes. Let's just - make them valid buffer contents, and finish conversion. */ - if (multibyte_p) - { - unsigned char *start = dst; - inserted += len_byte; - while (len_byte--) - { - int c = *src++; - dst += CHAR_STRING (c, dst); - } +/* Name (or base name) of work buffer for code conversion. */ +static Lisp_Object Vcode_conversion_workbuf_name; - inserted_byte += dst - start; - } - else - { - inserted += len_byte; - inserted_byte += len_byte; - while (len_byte--) - *dst++ = *src++; - } - break; - } - if (result == CODING_FINISH_INTERRUPT) - { - /* The conversion procedure was interrupted by a user. */ - break; - } - /* Now RESULT == CODING_FINISH_INSUFFICIENT_DST */ - if (coding->consumed < 1) - { - /* It's quite strange to require more memory without - consuming any bytes. Perhaps CCL program bug. */ - break; - } - if (first) - { - /* We have just done the first batch of conversion which was - stopped because of insufficient gap. Let's reconsider the - required gap size (i.e. SRT - DST) now. +/* A working buffer used by the top level conversion. Once it is + created, it is never destroyed. It has the name + Vcode_conversion_workbuf_name. The other working buffers are + destroyed after the use is finished, and their names are modified + versions of Vcode_conversion_workbuf_name. */ +static Lisp_Object Vcode_conversion_reused_workbuf; - We have converted ORIG bytes (== coding->consumed) into - NEW bytes (coding->produced). To convert the remaining - LEN bytes, we may need REQUIRE bytes of gap, where: - REQUIRE + LEN_BYTE = LEN_BYTE * (NEW / ORIG) - REQUIRE = LEN_BYTE * (NEW - ORIG) / ORIG - Here, we are sure that NEW >= ORIG. */ +/* 1 iff Vcode_conversion_reused_workbuf is already in use. */ +static int reused_workbuf_in_use; - if (coding->produced <= coding->consumed) - { - /* This happens because of CCL-based coding system with - eol-type CRLF. */ - require = 0; - } - else - { - float ratio = coding->produced - coding->consumed; - ratio /= coding->consumed; - require = len_byte * ratio; - } - first = 0; - } - if ((src - dst) < (require + 2000)) - { - /* See the comment above the previous call of make_gap. */ - int add = len_byte + inserted_byte; - GAP_SIZE -= add; - ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add; - GPT += inserted_byte; GPT_BYTE += inserted_byte; - make_gap (require + 2000); - GAP_SIZE += add; - ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add; - GPT -= inserted_byte; GPT_BYTE -= inserted_byte; - } - } - if (src - dst > 0) *dst = 0; /* Put an anchor. */ +/* Return a working buffer of code convesion. MULTIBYTE specifies the + multibyteness of returning buffer. */ - if (encodep && coding->dst_multibyte) - { - /* The output is unibyte. We must convert 8-bit characters to - multibyte form. */ - if (inserted_byte * 2 > GAP_SIZE) - { - GAP_SIZE -= inserted_byte; - ZV += inserted_byte; Z += inserted_byte; - ZV_BYTE += inserted_byte; Z_BYTE += inserted_byte; - GPT += inserted_byte; GPT_BYTE += inserted_byte; - make_gap (inserted_byte - GAP_SIZE); - GAP_SIZE += inserted_byte; - ZV -= inserted_byte; Z -= inserted_byte; - ZV_BYTE -= inserted_byte; Z_BYTE -= inserted_byte; - GPT -= inserted_byte; GPT_BYTE -= inserted_byte; - } - inserted_byte = str_to_multibyte (GPT_ADDR, GAP_SIZE, inserted_byte); - } +static Lisp_Object +make_conversion_work_buffer (multibyte) + int multibyte; +{ + Lisp_Object name, workbuf; + struct buffer *current; - /* If we shrank the conversion area, adjust it now. */ - if (total_skip > 0) + if (reused_workbuf_in_use++) { - if (tail_skip > 0) - safe_bcopy (GAP_END_ADDR, GPT_ADDR + inserted_byte, tail_skip); - inserted += total_skip; inserted_byte += total_skip; - GAP_SIZE += total_skip; - GPT -= head_skip; GPT_BYTE -= head_skip; - ZV -= total_skip; ZV_BYTE -= total_skip; - Z -= total_skip; Z_BYTE -= total_skip; - from -= head_skip; from_byte -= head_skip; - to += tail_skip; to_byte += tail_skip; + name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil); + workbuf = Fget_buffer_create (name); } - - prev_Z = Z; - if (! EQ (current_buffer->undo_list, Qt)) - adjust_after_replace (from, from_byte, deletion, inserted, inserted_byte); else - adjust_after_replace_noundo (from, from_byte, nchars_del, nbytes_del, - inserted, inserted_byte); - inserted = Z - prev_Z; - - if (!encodep && coding->cmp_data && coding->cmp_data->used) - coding_restore_composition (coding, Fcurrent_buffer ()); - coding_free_composition_data (coding); - - if (! inhibit_pre_post_conversion - && ! encodep && ! NILP (coding->post_read_conversion)) { - Lisp_Object val; - Lisp_Object saved_coding_system; + name = Vcode_conversion_workbuf_name; + workbuf = Fget_buffer_create (name); + if (NILP (Vcode_conversion_reused_workbuf)) + Vcode_conversion_reused_workbuf = workbuf; + } + current = current_buffer; + set_buffer_internal (XBUFFER (workbuf)); + Ferase_buffer (); + current_buffer->undo_list = Qt; + current_buffer->enable_multibyte_characters = multibyte ? Qt : Qnil; + set_buffer_internal (current); + return workbuf; +} - if (from != PT) - TEMP_SET_PT_BOTH (from, from_byte); - prev_Z = Z; - record_unwind_protect (code_convert_region_unwind, - Fcons (Vlast_coding_system_used, Qnil)); - saved_coding_system = Vlast_coding_system_used; - Vlast_coding_system_used = coding->symbol; - /* We should not call any more pre-write/post-read-conversion - functions while this post-read-conversion is running. */ - inhibit_pre_post_conversion = 1; - val = call1 (coding->post_read_conversion, make_number (inserted)); - inhibit_pre_post_conversion = 0; - coding->symbol = Vlast_coding_system_used; - Vlast_coding_system_used = saved_coding_system; - /* Discard the unwind protect. */ - specpdl_ptr--; - CHECK_NUMBER (val); - inserted += Z - prev_Z; - } - - if (orig_point >= from) - { - if (orig_point >= from + orig_len) - orig_point += inserted - orig_len; - else - orig_point = from; - TEMP_SET_PT (orig_point); - } - if (replace) +static Lisp_Object +code_conversion_restore (arg) + Lisp_Object arg; +{ + Lisp_Object current, workbuf; + struct gcpro gcpro1; + + GCPRO1 (arg); + current = XCAR (arg); + workbuf = XCDR (arg); + if (! NILP (workbuf)) { - signal_after_change (from, to - from, inserted); - update_compositions (from, from + inserted, CHECK_BORDER); + if (EQ (workbuf, Vcode_conversion_reused_workbuf)) + reused_workbuf_in_use = 0; + else if (! NILP (Fbuffer_live_p (workbuf))) + Fkill_buffer (workbuf); } + set_buffer_internal (XBUFFER (current)); + UNGCPRO; + return Qnil; +} - { - coding->consumed = to_byte - from_byte; - coding->consumed_char = to - from; - coding->produced = inserted_byte; - coding->produced_char = inserted; - } +Lisp_Object +code_conversion_save (with_work_buf, multibyte) + int with_work_buf, multibyte; +{ + Lisp_Object workbuf = Qnil; - return 0; + if (with_work_buf) + workbuf = make_conversion_work_buffer (multibyte); + record_unwind_protect (code_conversion_restore, + Fcons (Fcurrent_buffer (), workbuf)); + return workbuf; } -/* Name (or base name) of work buffer for code conversion. */ -static Lisp_Object Vcode_conversion_workbuf_name; +int +decode_coding_gap (coding, chars, bytes) + struct coding_system *coding; + EMACS_INT chars, bytes; +{ + int count = specpdl_ptr - specpdl; + Lisp_Object attrs; + + code_conversion_save (0, 0); + + coding->src_object = Fcurrent_buffer (); + coding->src_chars = chars; + coding->src_bytes = bytes; + coding->src_pos = -chars; + coding->src_pos_byte = -bytes; + coding->src_multibyte = chars < bytes; + coding->dst_object = coding->src_object; + coding->dst_pos = PT; + coding->dst_pos_byte = PT_BYTE; + coding->dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters); -/* Set the current buffer to the working buffer prepared for - code-conversion. MULTIBYTE specifies the multibyteness of the - buffer. Return the buffer we set if it must be killed after use. - Otherwise return Qnil. */ + if (CODING_REQUIRE_DETECTION (coding)) + detect_coding (coding); -static Lisp_Object -set_conversion_work_buffer (multibyte) - int multibyte; -{ - Lisp_Object buffer, buffer_to_kill; - struct buffer *buf; + coding->mode |= CODING_MODE_LAST_BLOCK; + current_buffer->text->inhibit_shrinking = 1; + decode_coding (coding); + current_buffer->text->inhibit_shrinking = 0; - buffer = Fget_buffer_create (Vcode_conversion_workbuf_name); - buf = XBUFFER (buffer); - if (buf == current_buffer) + attrs = CODING_ID_ATTRS (coding->id); + if (! NILP (CODING_ATTR_POST_READ (attrs))) { - /* As we are already in the work buffer, we must generate a new - buffer for the work. */ - Lisp_Object name; + EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE; + Lisp_Object val; - name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil); - buffer = buffer_to_kill = Fget_buffer_create (name); - buf = XBUFFER (buffer); + TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte); + val = call1 (CODING_ATTR_POST_READ (attrs), + make_number (coding->produced_char)); + CHECK_NATNUM (val); + coding->produced_char += Z - prev_Z; + coding->produced += Z_BYTE - prev_Z_BYTE; } - else - buffer_to_kill = Qnil; - - delete_all_overlays (buf); - buf->directory = current_buffer->directory; - buf->read_only = Qnil; - buf->filename = Qnil; - buf->undo_list = Qt; - eassert (buf->overlays_before == NULL); - eassert (buf->overlays_after == NULL); - set_buffer_internal (buf); - if (BEG != BEGV || Z != ZV) - Fwiden (); - del_range_2 (BEG, BEG_BYTE, Z, Z_BYTE, 0); - buf->enable_multibyte_characters = multibyte ? Qt : Qnil; - return buffer_to_kill; + + unbind_to (count, Qnil); + return coding->result; } -Lisp_Object -run_pre_post_conversion_on_str (str, coding, encodep) - Lisp_Object str; +int +encode_coding_gap (coding, chars, bytes) struct coding_system *coding; - int encodep; + EMACS_INT chars, bytes; { - int count = SPECPDL_INDEX (); - struct gcpro gcpro1, gcpro2; - int multibyte = STRING_MULTIBYTE (str); - Lisp_Object old_deactivate_mark; - Lisp_Object buffer_to_kill; - Lisp_Object unwind_arg; - - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - /* It is not crucial to specbind this. */ - old_deactivate_mark = Vdeactivate_mark; - GCPRO2 (str, old_deactivate_mark); - - /* We must insert the contents of STR as is without - unibyte<->multibyte conversion. For that, we adjust the - multibyteness of the working buffer to that of STR. */ - buffer_to_kill = set_conversion_work_buffer (multibyte); - if (NILP (buffer_to_kill)) - unwind_arg = Fcons (Vlast_coding_system_used, Qnil); - else - unwind_arg = list2 (Vlast_coding_system_used, buffer_to_kill); - record_unwind_protect (code_convert_region_unwind, unwind_arg); + int count = specpdl_ptr - specpdl; - insert_from_string (str, 0, 0, - SCHARS (str), SBYTES (str), 0); - UNGCPRO; - inhibit_pre_post_conversion = 1; - if (encodep) - { - struct buffer *prev = current_buffer; + code_conversion_save (0, 0); - call2 (coding->pre_write_conversion, make_number (BEG), make_number (Z)); - if (prev != current_buffer) - /* We must kill the current buffer too. */ - Fsetcdr (unwind_arg, Fcons (Fcurrent_buffer (), XCDR (unwind_arg))); - } - else - { - Vlast_coding_system_used = coding->symbol; - TEMP_SET_PT_BOTH (BEG, BEG_BYTE); - call1 (coding->post_read_conversion, make_number (Z - BEG)); - coding->symbol = Vlast_coding_system_used; - } - inhibit_pre_post_conversion = 0; - Vdeactivate_mark = old_deactivate_mark; - str = make_buffer_string (BEG, Z, 1); - return unbind_to (count, str); + coding->src_object = Fcurrent_buffer (); + coding->src_chars = chars; + coding->src_bytes = bytes; + coding->src_pos = -chars; + coding->src_pos_byte = -bytes; + coding->src_multibyte = chars < bytes; + coding->dst_object = coding->src_object; + coding->dst_pos = PT; + coding->dst_pos_byte = PT_BYTE; + + encode_coding (coding); + + unbind_to (count, Qnil); + return coding->result; } -/* Run pre-write-conversion function of CODING on NCHARS/NBYTES - text in *STR. *SIZE is the allocated bytes for STR. As it - is intended that this function is called from encode_terminal_code, - the pre-write-conversion function is run by safe_call and thus - "Error during redisplay: ..." is logged when an error occurs. +/* Decode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in + SRC_OBJECT into DST_OBJECT by coding context CODING. + + SRC_OBJECT is a buffer, a string, or Qnil. - Store the resulting text in *STR and set CODING->produced_char and - CODING->produced to the number of characters and bytes - respectively. If the size of *STR is too small, enlarge it by - xrealloc and update *STR and *SIZE. */ + If it is a buffer, the text is at point of the buffer. FROM and TO + are positions in the buffer. + + If it is a string, the text is at the beginning of the string. + FROM and TO are indices to the string. + + If it is nil, the text is at coding->source. FROM and TO are + indices to coding->source. + + DST_OBJECT is a buffer, Qt, or Qnil. + + If it is a buffer, the decoded text is inserted at point of the + buffer. If the buffer is the same as SRC_OBJECT, the source text + is deleted. + + If it is Qt, a string is made from the decoded text, and + set in CODING->dst_object. + + If it is Qnil, the decoded text is stored at CODING->destination. + The caller must allocate CODING->dst_bytes bytes at + CODING->destination by xmalloc. If the decoded text is longer than + CODING->dst_bytes, CODING->destination is relocated by xrealloc. + */ void -run_pre_write_conversin_on_c_str (str, size, nchars, nbytes, coding) - unsigned char **str; - int *size, nchars, nbytes; +decode_coding_object (coding, src_object, from, from_byte, to, to_byte, + dst_object) struct coding_system *coding; + Lisp_Object src_object; + EMACS_INT from, from_byte, to, to_byte; + Lisp_Object dst_object; { - struct gcpro gcpro1, gcpro2; - struct buffer *cur = current_buffer; - struct buffer *prev; - Lisp_Object old_deactivate_mark, old_last_coding_system_used; - Lisp_Object args[3]; - Lisp_Object buffer_to_kill; - - /* It is not crucial to specbind this. */ - old_deactivate_mark = Vdeactivate_mark; - old_last_coding_system_used = Vlast_coding_system_used; - GCPRO2 (old_deactivate_mark, old_last_coding_system_used); - - /* We must insert the contents of STR as is without - unibyte<->multibyte conversion. For that, we adjust the - multibyteness of the working buffer to that of STR. */ - buffer_to_kill = set_conversion_work_buffer (coding->src_multibyte); - insert_1_both (*str, nchars, nbytes, 0, 0, 0); - UNGCPRO; - inhibit_pre_post_conversion = 1; - prev = current_buffer; - args[0] = coding->pre_write_conversion; - args[1] = make_number (BEG); - args[2] = make_number (Z); - safe_call (3, args); - inhibit_pre_post_conversion = 0; - Vdeactivate_mark = old_deactivate_mark; - Vlast_coding_system_used = old_last_coding_system_used; - coding->produced_char = Z - BEG; - coding->produced = Z_BYTE - BEG_BYTE; - if (coding->produced > *size) - { - *size = coding->produced; - *str = xrealloc (*str, *size); - } - if (BEG < GPT && GPT < Z) - move_gap (BEG); - bcopy (BEG_ADDR, *str, coding->produced); - coding->src_multibyte - = ! NILP (current_buffer->enable_multibyte_characters); - if (prev != current_buffer) - Fkill_buffer (Fcurrent_buffer ()); - set_buffer_internal (cur); - if (! NILP (buffer_to_kill)) - Fkill_buffer (buffer_to_kill); -} + int count = specpdl_ptr - specpdl; + unsigned char *destination; + EMACS_INT dst_bytes; + EMACS_INT chars = to - from; + EMACS_INT bytes = to_byte - from_byte; + Lisp_Object attrs; + Lisp_Object buffer; + int saved_pt = -1, saved_pt_byte; + buffer = Fcurrent_buffer (); -Lisp_Object -decode_coding_string (str, coding, nocopy) - Lisp_Object str; - struct coding_system *coding; - int nocopy; -{ - int len; - struct conversion_buffer buf; - int from, to_byte; - Lisp_Object saved_coding_symbol; - int result; - int require_decoding; - int shrinked_bytes = 0; - Lisp_Object newstr; - int consumed, consumed_char, produced, produced_char; - - from = 0; - to_byte = SBYTES (str); - - saved_coding_symbol = coding->symbol; - coding->src_multibyte = STRING_MULTIBYTE (str); - coding->dst_multibyte = 1; - coding->heading_ascii = 0; + if (NILP (dst_object)) + { + destination = coding->destination; + dst_bytes = coding->dst_bytes; + } - if (CODING_REQUIRE_DETECTION (coding)) + coding->src_object = src_object; + coding->src_chars = chars; + coding->src_bytes = bytes; + coding->src_multibyte = chars < bytes; + + if (STRINGP (src_object)) + { + coding->src_pos = from; + coding->src_pos_byte = from_byte; + } + else if (BUFFERP (src_object)) { - /* See the comments in code_convert_region. */ - if (coding->type == coding_type_undecided) + set_buffer_internal (XBUFFER (src_object)); + if (from != GPT) + move_gap_both (from, from_byte); + if (EQ (src_object, dst_object)) { - detect_coding (coding, SDATA (str), to_byte); - if (coding->type == coding_type_undecided) - { - coding->type = coding_type_emacs_mule; - coding->category_idx = CODING_CATEGORY_IDX_EMACS_MULE; - /* As emacs-mule decoder will handle composition, we - need this setting to allocate coding->cmp_data - later. */ - coding->composing = COMPOSITION_NO; - } + saved_pt = PT, saved_pt_byte = PT_BYTE; + TEMP_SET_PT_BOTH (from, from_byte); + del_range_both (from, from_byte, to, to_byte, 1); + coding->src_pos = -chars; + coding->src_pos_byte = -bytes; } - if (coding->eol_type == CODING_EOL_UNDECIDED - && coding->type != coding_type_ccl) + else { - saved_coding_symbol = coding->symbol; - detect_eol (coding, SDATA (str), to_byte); - if (coding->eol_type == CODING_EOL_UNDECIDED) - coding->eol_type = CODING_EOL_LF; - /* We had better recover the original eol format if we - encounter an inconsistent eol format while decoding. */ - coding->mode |= CODING_MODE_INHIBIT_INCONSISTENT_EOL; + coding->src_pos = from; + coding->src_pos_byte = from_byte; } } - if (coding->type == coding_type_no_conversion - || coding->type == coding_type_raw_text) - coding->dst_multibyte = 0; - - require_decoding = CODING_REQUIRE_DECODING (coding); + if (CODING_REQUIRE_DETECTION (coding)) + detect_coding (coding); + attrs = CODING_ID_ATTRS (coding->id); - if (STRING_MULTIBYTE (str)) + if (EQ (dst_object, Qt) + || (! NILP (CODING_ATTR_POST_READ (attrs)) + && NILP (dst_object))) { - /* Decoding routines expect the source text to be unibyte. */ - str = Fstring_as_unibyte (str); - to_byte = SBYTES (str); - nocopy = 1; - coding->src_multibyte = 0; + coding->dst_object = code_conversion_save (1, 1); + coding->dst_pos = BEG; + coding->dst_pos_byte = BEG_BYTE; + coding->dst_multibyte = 1; } - - /* Try to skip the heading and tailing ASCIIs. */ - if (require_decoding && coding->type != coding_type_ccl) + else if (BUFFERP (dst_object)) { - SHRINK_CONVERSION_REGION (&from, &to_byte, coding, SDATA (str), - 0); - if (from == to_byte) - require_decoding = 0; - shrinked_bytes = from + (SBYTES (str) - to_byte); + code_conversion_save (0, 0); + coding->dst_object = dst_object; + coding->dst_pos = BUF_PT (XBUFFER (dst_object)); + coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object)); + coding->dst_multibyte + = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters); } - - if (!require_decoding - && !(SYMBOLP (coding->post_read_conversion) - && !NILP (Ffboundp (coding->post_read_conversion)))) + else { - coding->consumed = SBYTES (str); - coding->consumed_char = SCHARS (str); - if (coding->dst_multibyte) - { - str = Fstring_as_multibyte (str); - nocopy = 1; - } - coding->produced = SBYTES (str); - coding->produced_char = SCHARS (str); - return (nocopy ? str : Fcopy_sequence (str)); + code_conversion_save (0, 0); + coding->dst_object = Qnil; + coding->dst_multibyte = 1; } - if (coding->composing != COMPOSITION_DISABLED) - coding_allocate_composition_data (coding, from); - len = decoding_buffer_size (coding, to_byte - from); - allocate_conversion_buffer (buf, len); + decode_coding (coding); - consumed = consumed_char = produced = produced_char = 0; - while (1) + if (BUFFERP (coding->dst_object)) + set_buffer_internal (XBUFFER (coding->dst_object)); + + if (! NILP (CODING_ATTR_POST_READ (attrs))) { - result = decode_coding (coding, SDATA (str) + from + consumed, - buf.data + produced, to_byte - from - consumed, - buf.size - produced); - consumed += coding->consumed; - consumed_char += coding->consumed_char; - produced += coding->produced; - produced_char += coding->produced_char; - if (result == CODING_FINISH_NORMAL - || result == CODING_FINISH_INTERRUPT - || (result == CODING_FINISH_INSUFFICIENT_SRC - && coding->consumed == 0)) - break; - if (result == CODING_FINISH_INSUFFICIENT_CMP) - coding_allocate_composition_data (coding, from + produced_char); - else if (result == CODING_FINISH_INSUFFICIENT_DST) - extend_conversion_buffer (&buf); - else if (result == CODING_FINISH_INCONSISTENT_EOL) - { - Lisp_Object eol_type; + struct gcpro gcpro1, gcpro2; + EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE; + Lisp_Object val; - /* Recover the original EOL format. */ - if (coding->eol_type == CODING_EOL_CR) - { - unsigned char *p; - for (p = buf.data; p < buf.data + produced; p++) - if (*p == '\n') *p = '\r'; - } - else if (coding->eol_type == CODING_EOL_CRLF) + TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte); + GCPRO2 (coding->src_object, coding->dst_object); + val = safe_call1 (CODING_ATTR_POST_READ (attrs), + make_number (coding->produced_char)); + UNGCPRO; + CHECK_NATNUM (val); + coding->produced_char += Z - prev_Z; + coding->produced += Z_BYTE - prev_Z_BYTE; + } + + if (EQ (dst_object, Qt)) + { + coding->dst_object = Fbuffer_string (); + } + else if (NILP (dst_object) && BUFFERP (coding->dst_object)) + { + set_buffer_internal (XBUFFER (coding->dst_object)); + if (dst_bytes < coding->produced) + { + destination + = (unsigned char *) xrealloc (destination, coding->produced); + if (! destination) { - int num_eol = 0; - unsigned char *p0, *p1; - for (p0 = buf.data, p1 = p0 + produced; p0 < p1; p0++) - if (*p0 == '\n') num_eol++; - if (produced + num_eol >= buf.size) - extend_conversion_buffer (&buf); - for (p0 = buf.data + produced, p1 = p0 + num_eol; p0 > buf.data;) - { - *--p1 = *--p0; - if (*p0 == '\n') *--p1 = '\r'; - } - produced += num_eol; - produced_char += num_eol; + record_conversion_result (coding, + CODING_RESULT_INSUFFICIENT_DST); + unbind_to (count, Qnil); + return; } - /* Suppress eol-format conversion in the further conversion. */ - coding->eol_type = CODING_EOL_LF; - - /* Set the coding system symbol to that for Unix-like EOL. */ - eol_type = Fget (saved_coding_symbol, Qeol_type); - if (VECTORP (eol_type) - && XVECTOR (eol_type)->size == 3 - && SYMBOLP (XVECTOR (eol_type)->contents[CODING_EOL_LF])) - coding->symbol = XVECTOR (eol_type)->contents[CODING_EOL_LF]; - else - coding->symbol = saved_coding_symbol; - - + if (BEGV < GPT && GPT < BEGV + coding->produced_char) + move_gap_both (BEGV, BEGV_BYTE); + bcopy (BEGV_ADDR, destination, coding->produced); + coding->destination = destination; } } - coding->consumed = consumed; - coding->consumed_char = consumed_char; - coding->produced = produced; - coding->produced_char = produced_char; + if (saved_pt >= 0) + { + /* This is the case of: + (BUFFERP (src_object) && EQ (src_object, dst_object)) + As we have moved PT while replacing the original buffer + contents, we must recover it now. */ + set_buffer_internal (XBUFFER (src_object)); + if (saved_pt < from) + TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); + else if (saved_pt < from + chars) + TEMP_SET_PT_BOTH (from, from_byte); + else if (! NILP (current_buffer->enable_multibyte_characters)) + TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), + saved_pt_byte + (coding->produced - bytes)); + else + TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes), + saved_pt_byte + (coding->produced - bytes)); + } - if (coding->dst_multibyte) - newstr = make_uninit_multibyte_string (produced_char + shrinked_bytes, - produced + shrinked_bytes); - else - newstr = make_uninit_string (produced + shrinked_bytes); - if (from > 0) - STRING_COPYIN (newstr, 0, SDATA (str), from); - STRING_COPYIN (newstr, from, buf.data, produced); - if (shrinked_bytes > from) - STRING_COPYIN (newstr, from + produced, - SDATA (str) + to_byte, - shrinked_bytes - from); - free_conversion_buffer (&buf); - - coding->consumed += shrinked_bytes; - coding->consumed_char += shrinked_bytes; - coding->produced += shrinked_bytes; - coding->produced_char += shrinked_bytes; - - if (coding->cmp_data && coding->cmp_data->used) - coding_restore_composition (coding, newstr); - coding_free_composition_data (coding); - - if (SYMBOLP (coding->post_read_conversion) - && !NILP (Ffboundp (coding->post_read_conversion))) - newstr = run_pre_post_conversion_on_str (newstr, coding, 0); - - return newstr; + unbind_to (count, coding->dst_object); } -Lisp_Object -encode_coding_string (str, coding, nocopy) - Lisp_Object str; + +void +encode_coding_object (coding, src_object, from, from_byte, to, to_byte, + dst_object) struct coding_system *coding; - int nocopy; + Lisp_Object src_object; + EMACS_INT from, from_byte, to, to_byte; + Lisp_Object dst_object; { - int len; - struct conversion_buffer buf; - int from, to, to_byte; - int result; - int shrinked_bytes = 0; - Lisp_Object newstr; - int consumed, consumed_char, produced, produced_char; - - if (SYMBOLP (coding->pre_write_conversion) - && !NILP (Ffboundp (coding->pre_write_conversion))) - { - str = run_pre_post_conversion_on_str (str, coding, 1); - /* As STR is just newly generated, we don't have to copy it - anymore. */ - nocopy = 1; - } + int count = specpdl_ptr - specpdl; + EMACS_INT chars = to - from; + EMACS_INT bytes = to_byte - from_byte; + Lisp_Object attrs; + Lisp_Object buffer; + int saved_pt = -1, saved_pt_byte; + int kill_src_buffer = 0; + + buffer = Fcurrent_buffer (); + + coding->src_object = src_object; + coding->src_chars = chars; + coding->src_bytes = bytes; + coding->src_multibyte = chars < bytes; + + attrs = CODING_ID_ATTRS (coding->id); + + if (! NILP (CODING_ATTR_PRE_WRITE (attrs))) + { + coding->src_object = code_conversion_save (1, coding->src_multibyte); + set_buffer_internal (XBUFFER (coding->src_object)); + if (STRINGP (src_object)) + insert_from_string (src_object, from, from_byte, chars, bytes, 0); + else if (BUFFERP (src_object)) + insert_from_buffer (XBUFFER (src_object), from, chars, 0); + else + insert_1_both (coding->source + from, chars, bytes, 0, 0, 0); - from = 0; - to = SCHARS (str); - to_byte = SBYTES (str); + if (EQ (src_object, dst_object)) + { + set_buffer_internal (XBUFFER (src_object)); + saved_pt = PT, saved_pt_byte = PT_BYTE; + del_range_both (from, from_byte, to, to_byte, 1); + set_buffer_internal (XBUFFER (coding->src_object)); + } - /* Encoding routines determine the multibyteness of the source text - by coding->src_multibyte. */ - coding->src_multibyte = SCHARS (str) < SBYTES (str); - coding->dst_multibyte = 0; - if (! CODING_REQUIRE_ENCODING (coding)) - goto no_need_of_encoding; + { + Lisp_Object args[3]; - if (coding->composing != COMPOSITION_DISABLED) - coding_save_composition (coding, from, to, str); + args[0] = CODING_ATTR_PRE_WRITE (attrs); + args[1] = make_number (BEG); + args[2] = make_number (Z); + safe_call (3, args); + } + if (XBUFFER (coding->src_object) != current_buffer) + kill_src_buffer = 1; + coding->src_object = Fcurrent_buffer (); + if (BEG != GPT) + move_gap_both (BEG, BEG_BYTE); + coding->src_chars = Z - BEG; + coding->src_bytes = Z_BYTE - BEG_BYTE; + coding->src_pos = BEG; + coding->src_pos_byte = BEG_BYTE; + coding->src_multibyte = Z < Z_BYTE; + } + else if (STRINGP (src_object)) + { + code_conversion_save (0, 0); + coding->src_pos = from; + coding->src_pos_byte = from_byte; + } + else if (BUFFERP (src_object)) + { + code_conversion_save (0, 0); + set_buffer_internal (XBUFFER (src_object)); + if (EQ (src_object, dst_object)) + { + saved_pt = PT, saved_pt_byte = PT_BYTE; + coding->src_object = del_range_1 (from, to, 1, 1); + coding->src_pos = 0; + coding->src_pos_byte = 0; + } + else + { + if (from < GPT && to >= GPT) + move_gap_both (from, from_byte); + coding->src_pos = from; + coding->src_pos_byte = from_byte; + } + } + else + code_conversion_save (0, 0); - /* Try to skip the heading and tailing ASCIIs. We can't skip them - if we must run CCL program or there are compositions to - encode. */ - coding->heading_ascii = 0; - if (coding->type != coding_type_ccl - && (! coding->cmp_data || coding->cmp_data->used == 0)) + if (BUFFERP (dst_object)) { - SHRINK_CONVERSION_REGION (&from, &to_byte, coding, SDATA (str), - 1); - if (from == to_byte) + coding->dst_object = dst_object; + if (EQ (src_object, dst_object)) { - coding_free_composition_data (coding); - goto no_need_of_encoding; + coding->dst_pos = from; + coding->dst_pos_byte = from_byte; } - shrinked_bytes = from + (SBYTES (str) - to_byte); + else + { + coding->dst_pos = BUF_PT (XBUFFER (dst_object)); + coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object)); + } + coding->dst_multibyte + = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters); + } + else if (EQ (dst_object, Qt)) + { + coding->dst_object = Qnil; + coding->dst_bytes = coding->src_chars; + if (coding->dst_bytes == 0) + coding->dst_bytes = 1; + coding->destination = (unsigned char *) xmalloc (coding->dst_bytes); + coding->dst_multibyte = 0; + } + else + { + coding->dst_object = Qnil; + coding->dst_multibyte = 0; } - len = encoding_buffer_size (coding, to_byte - from); - allocate_conversion_buffer (buf, len); + encode_coding (coding); - consumed = consumed_char = produced = produced_char = 0; - while (1) + if (EQ (dst_object, Qt)) { - result = encode_coding (coding, SDATA (str) + from + consumed, - buf.data + produced, to_byte - from - consumed, - buf.size - produced); - consumed += coding->consumed; - consumed_char += coding->consumed_char; - produced += coding->produced; - produced_char += coding->produced_char; - if (result == CODING_FINISH_NORMAL - || result == CODING_FINISH_INTERRUPT - || (result == CODING_FINISH_INSUFFICIENT_SRC - && coding->consumed == 0)) - break; - /* Now result should be CODING_FINISH_INSUFFICIENT_DST. */ - extend_conversion_buffer (&buf); - } - - coding->consumed = consumed; - coding->consumed_char = consumed_char; - coding->produced = produced; - coding->produced_char = produced_char; - - newstr = make_uninit_string (produced + shrinked_bytes); - if (from > 0) - STRING_COPYIN (newstr, 0, SDATA (str), from); - STRING_COPYIN (newstr, from, buf.data, produced); - if (shrinked_bytes > from) - STRING_COPYIN (newstr, from + produced, - SDATA (str) + to_byte, - shrinked_bytes - from); - - free_conversion_buffer (&buf); - coding_free_composition_data (coding); - - return newstr; - - no_need_of_encoding: - coding->consumed = SBYTES (str); - coding->consumed_char = SCHARS (str); - if (STRING_MULTIBYTE (str)) - { - if (nocopy) - /* We are sure that STR doesn't contain a multibyte - character. */ - STRING_SET_UNIBYTE (str); + if (BUFFERP (coding->dst_object)) + coding->dst_object = Fbuffer_string (); else { - str = Fstring_as_unibyte (str); - nocopy = 1; + coding->dst_object + = make_unibyte_string ((char *) coding->destination, + coding->produced); + xfree (coding->destination); } } - coding->produced = SBYTES (str); - coding->produced_char = SCHARS (str); - return (nocopy ? str : Fcopy_sequence (str)); + + if (saved_pt >= 0) + { + /* This is the case of: + (BUFFERP (src_object) && EQ (src_object, dst_object)) + As we have moved PT while replacing the original buffer + contents, we must recover it now. */ + set_buffer_internal (XBUFFER (src_object)); + if (saved_pt < from) + TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); + else if (saved_pt < from + chars) + TEMP_SET_PT_BOTH (from, from_byte); + else if (! NILP (current_buffer->enable_multibyte_characters)) + TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), + saved_pt_byte + (coding->produced - bytes)); + else + TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes), + saved_pt_byte + (coding->produced - bytes)); + } + + if (kill_src_buffer) + Fkill_buffer (coding->src_object); + unbind_to (count, Qnil); +} + + +Lisp_Object +preferred_coding_system () +{ + int id = coding_categories[coding_priorities[0]].id; + + return CODING_ID_NAME (id); } @@ -6521,21 +7164,18 @@ encode_coding_string (str, coding, nocopy) DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0, doc: /* Return t if OBJECT is nil or a coding-system. -See the documentation of `make-coding-system' for information +See the documentation of `define-coding-system' for information about coding-system objects. */) (obj) Lisp_Object obj; { - if (NILP (obj)) + if (NILP (obj) + || CODING_SYSTEM_ID (obj) >= 0) return Qt; - if (!SYMBOLP (obj)) + if (! SYMBOLP (obj) + || NILP (Fget (obj, Qcoding_system_define_form))) return Qnil; - if (! NILP (Fget (obj, Qcoding_system_define_form))) - return Qt; - /* Get coding-spec vector for OBJ. */ - obj = Fget (obj, Qcoding_system); - return ((VECTORP (obj) && XVECTOR (obj)->size == 5) - ? Qt : Qnil); + return Qt; } DEFUN ("read-non-nil-coding-system", Fread_non_nil_coding_system, @@ -6579,9 +7219,9 @@ DEFUN ("check-coding-system", Fcheck_coding_system, Scheck_coding_system, 1, 1, 0, doc: /* Check validity of CODING-SYSTEM. If valid, return CODING-SYSTEM, else signal a `coding-system-error' error. -It is valid if it is nil or a symbol with a non-nil `coding-system' property. -The value of this property should be a vector of length 5. */) - (coding_system) +It is valid if it is nil or a symbol defined as a coding system by the +function `define-coding-system'. */) + (coding_system) Lisp_Object coding_system; { Lisp_Object define_form; @@ -6596,77 +7236,289 @@ The value of this property should be a vector of length 5. */) return coding_system; xsignal1 (Qcoding_system_error, coding_system); } + +/* Detect how the bytes at SRC of length SRC_BYTES are encoded. If + HIGHEST is nonzero, return the coding system of the highest + priority among the detected coding systems. Otherwize return a + list of detected coding systems sorted by their priorities. If + MULTIBYTEP is nonzero, it is assumed that the bytes are in correct + multibyte form but contains only ASCII and eight-bit chars. + Otherwise, the bytes are raw bytes. + + CODING-SYSTEM controls the detection as below: + + If it is nil, detect both text-format and eol-format. If the + text-format part of CODING-SYSTEM is already specified + (e.g. `iso-latin-1'), detect only eol-format. If the eol-format + part of CODING-SYSTEM is already specified (e.g. `undecided-unix'), + detect only text-format. */ + Lisp_Object -detect_coding_system (src, src_bytes, highest, multibytep) +detect_coding_system (src, src_chars, src_bytes, highest, multibytep, + coding_system) const unsigned char *src; - int src_bytes, highest; + int src_chars, src_bytes, highest; int multibytep; + Lisp_Object coding_system; { - int coding_mask, eol_type; - Lisp_Object val, tmp; - int dummy; + const unsigned char *src_end = src + src_bytes; + Lisp_Object attrs, eol_type; + Lisp_Object val; + struct coding_system coding; + int id; + struct coding_detection_info detect_info; + enum coding_category base_category; - coding_mask = detect_coding_mask (src, src_bytes, NULL, &dummy, multibytep); - eol_type = detect_eol_type (src, src_bytes, &dummy); - if (eol_type == CODING_EOL_INCONSISTENT) - eol_type = CODING_EOL_UNDECIDED; + if (NILP (coding_system)) + coding_system = Qundecided; + setup_coding_system (coding_system, &coding); + attrs = CODING_ID_ATTRS (coding.id); + eol_type = CODING_ID_EOL_TYPE (coding.id); + coding_system = CODING_ATTR_BASE_NAME (attrs); + + coding.source = src; + coding.src_chars = src_chars; + coding.src_bytes = src_bytes; + coding.src_multibyte = multibytep; + coding.consumed = 0; + coding.mode |= CODING_MODE_LAST_BLOCK; + + detect_info.checked = detect_info.found = detect_info.rejected = 0; - if (!coding_mask) + /* At first, detect text-format if necessary. */ + base_category = XINT (CODING_ATTR_CATEGORY (attrs)); + if (base_category == coding_category_undecided) { - val = Qundecided; - if (eol_type != CODING_EOL_UNDECIDED) + enum coding_category category; + struct coding_system *this; + int c, i; + + /* Skip all ASCII bytes except for a few ISO2022 controls. */ + for (i = 0; src < src_end; i++, src++) { - Lisp_Object val2; - val2 = Fget (Qundecided, Qeol_type); - if (VECTORP (val2)) - val = XVECTOR (val2)->contents[eol_type]; + c = *src; + if (c & 0x80) + break; + if (c < 0x20 + && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO) + && ! inhibit_iso_escape_detection) + { + coding.head_ascii = src - coding.source; + if (detect_coding_iso_2022 (&coding, &detect_info)) + { + /* We have scanned the whole data. */ + if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE)) + /* We didn't find an 8-bit code. */ + src = src_end; + break; + } + } } - return (highest ? val : Fcons (val, Qnil)); - } + coding.head_ascii = src - coding.source; - /* At first, gather possible coding systems in VAL. */ - val = Qnil; - for (tmp = Vcoding_category_list; CONSP (tmp); tmp = XCDR (tmp)) - { - Lisp_Object category_val, category_index; + if (src < src_end + || detect_info.found) + { + if (src == src_end) + /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */ + for (i = 0; i < coding_category_raw_text; i++) + { + category = coding_priorities[i]; + this = coding_categories + category; + if (detect_info.found & (1 << category)) + break; + } + else + for (i = 0; i < coding_category_raw_text; i++) + { + category = coding_priorities[i]; + this = coding_categories + category; + + if (this->id < 0) + { + /* No coding system of this category is defined. */ + detect_info.rejected |= (1 << category); + } + else if (category >= coding_category_raw_text) + continue; + else if (detect_info.checked & (1 << category)) + { + if (highest + && (detect_info.found & (1 << category))) + break; + } + else + { + if ((*(this->detector)) (&coding, &detect_info) + && highest + && (detect_info.found & (1 << category))) + { + if (category == coding_category_utf_16_auto) + { + if (detect_info.found & CATEGORY_MASK_UTF_16_LE) + category = coding_category_utf_16_le; + else + category = coding_category_utf_16_be; + } + break; + } + } + } + } - category_index = Fget (XCAR (tmp), Qcoding_category_index); - category_val = Fsymbol_value (XCAR (tmp)); - if (!NILP (category_val) - && NATNUMP (category_index) - && (coding_mask & (1 << XFASTINT (category_index)))) + if (detect_info.rejected == CATEGORY_MASK_ANY) { - val = Fcons (category_val, val); - if (highest) - break; + detect_info.found = CATEGORY_MASK_RAW_TEXT; + id = coding_categories[coding_category_raw_text].id; + val = Fcons (make_number (id), Qnil); } - } - if (!highest) - val = Fnreverse (val); + else if (! detect_info.rejected && ! detect_info.found) + { + detect_info.found = CATEGORY_MASK_ANY; + id = coding_categories[coding_category_undecided].id; + val = Fcons (make_number (id), Qnil); + } + else if (highest) + { + if (detect_info.found) + { + detect_info.found = 1 << category; + val = Fcons (make_number (this->id), Qnil); + } + else + for (i = 0; i < coding_category_raw_text; i++) + if (! (detect_info.rejected & (1 << coding_priorities[i]))) + { + detect_info.found = 1 << coding_priorities[i]; + id = coding_categories[coding_priorities[i]].id; + val = Fcons (make_number (id), Qnil); + break; + } + } + else + { + int mask = detect_info.rejected | detect_info.found; + int found = 0; + val = Qnil; - /* Then, replace the elements with subsidiary coding systems. */ - for (tmp = val; CONSP (tmp); tmp = XCDR (tmp)) + for (i = coding_category_raw_text - 1; i >= 0; i--) + { + category = coding_priorities[i]; + if (! (mask & (1 << category))) + { + found |= 1 << category; + id = coding_categories[category].id; + if (id >= 0) + val = Fcons (make_number (id), val); + } + } + for (i = coding_category_raw_text - 1; i >= 0; i--) + { + category = coding_priorities[i]; + if (detect_info.found & (1 << category)) + { + id = coding_categories[category].id; + val = Fcons (make_number (id), val); + } + } + detect_info.found |= found; + } + } + else if (base_category == coding_category_utf_16_auto) { - if (eol_type != CODING_EOL_UNDECIDED - && eol_type != CODING_EOL_INCONSISTENT) + if (detect_coding_utf_16 (&coding, &detect_info)) { - Lisp_Object eol; - eol = Fget (XCAR (tmp), Qeol_type); - if (VECTORP (eol)) - XSETCAR (tmp, XVECTOR (eol)->contents[eol_type]); + struct coding_system *this; + + if (detect_info.found & CATEGORY_MASK_UTF_16_LE) + this = coding_categories + coding_category_utf_16_le; + else if (detect_info.found & CATEGORY_MASK_UTF_16_BE) + this = coding_categories + coding_category_utf_16_be; + else if (detect_info.rejected & CATEGORY_MASK_UTF_16_LE_NOSIG) + this = coding_categories + coding_category_utf_16_be_nosig; + else + this = coding_categories + coding_category_utf_16_le_nosig; + val = Fcons (make_number (this->id), Qnil); } } + else + { + detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs)); + val = Fcons (make_number (coding.id), Qnil); + } + + /* Then, detect eol-format if necessary. */ + { + int normal_eol = -1, utf_16_be_eol = -1, utf_16_le_eol; + Lisp_Object tail; + + if (VECTORP (eol_type)) + { + if (detect_info.found & ~CATEGORY_MASK_UTF_16) + normal_eol = detect_eol (coding.source, src_bytes, + coding_category_raw_text); + if (detect_info.found & (CATEGORY_MASK_UTF_16_BE + | CATEGORY_MASK_UTF_16_BE_NOSIG)) + utf_16_be_eol = detect_eol (coding.source, src_bytes, + coding_category_utf_16_be); + if (detect_info.found & (CATEGORY_MASK_UTF_16_LE + | CATEGORY_MASK_UTF_16_LE_NOSIG)) + utf_16_le_eol = detect_eol (coding.source, src_bytes, + coding_category_utf_16_le); + } + else + { + if (EQ (eol_type, Qunix)) + normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_LF; + else if (EQ (eol_type, Qdos)) + normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CRLF; + else + normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CR; + } + + for (tail = val; CONSP (tail); tail = XCDR (tail)) + { + enum coding_category category; + int this_eol; + + id = XINT (XCAR (tail)); + attrs = CODING_ID_ATTRS (id); + category = XINT (CODING_ATTR_CATEGORY (attrs)); + eol_type = CODING_ID_EOL_TYPE (id); + if (VECTORP (eol_type)) + { + if (category == coding_category_utf_16_be + || category == coding_category_utf_16_be_nosig) + this_eol = utf_16_be_eol; + else if (category == coding_category_utf_16_le + || category == coding_category_utf_16_le_nosig) + this_eol = utf_16_le_eol; + else + this_eol = normal_eol; + + if (this_eol == EOL_SEEN_LF) + XSETCAR (tail, AREF (eol_type, 0)); + else if (this_eol == EOL_SEEN_CRLF) + XSETCAR (tail, AREF (eol_type, 1)); + else if (this_eol == EOL_SEEN_CR) + XSETCAR (tail, AREF (eol_type, 2)); + else + XSETCAR (tail, CODING_ID_NAME (id)); + } + else + XSETCAR (tail, CODING_ID_NAME (id)); + } + } + return (highest ? XCAR (val) : val); } + DEFUN ("detect-coding-region", Fdetect_coding_region, Sdetect_coding_region, 2, 3, 0, - doc: /* Detect how the byte sequence in the region is encoded. -Return a list of possible coding systems used on decoding a byte -sequence containing the bytes in the region between START and END when -the coding system `undecided' is specified. The list is ordered by -priority decided in the current language environment. + doc: /* Detect coding system of the text in the region between START and END. +Return a list of possible coding systems ordered by priority. If only ASCII characters are found (except for such ISO-2022 control characters ISO-2022 as ESC), it returns a list of single element @@ -6680,7 +7532,6 @@ highest priority. */) { int from, to; int from_byte, to_byte; - int include_anchor_byte = 0; CHECK_NUMBER_COERCE_MARKER (start); CHECK_NUMBER_COERCE_MARKER (end); @@ -6692,29 +7543,19 @@ highest priority. */) if (from < GPT && to >= GPT) move_gap_both (to, to_byte); - /* If we an anchor byte `\0' follows the region, we include it in - the detecting source. Then code detectors can handle the tailing - byte sequence more accurately. - Fix me: This is not a perfect solution. It is better that we - add one more argument, say LAST_BLOCK, to all detect_coding_XXX. - */ - if (to == Z || (to == GPT && GAP_SIZE > 0)) - include_anchor_byte = 1; return detect_coding_system (BYTE_POS_ADDR (from_byte), - to_byte - from_byte + include_anchor_byte, + to - from, to_byte - from_byte, !NILP (highest), !NILP (current_buffer - ->enable_multibyte_characters)); + ->enable_multibyte_characters), + Qnil); } DEFUN ("detect-coding-string", Fdetect_coding_string, Sdetect_coding_string, 1, 2, 0, - doc: /* Detect how the byte sequence in STRING is encoded. -Return a list of possible coding systems used on decoding a byte -sequence containing the bytes in STRING when the coding system -`undecided' is specified. The list is ordered by priority decided in -the current language environment. + doc: /* Detect coding system of the text in STRING. +Return a list of possible coding systems ordered by priority. If only ASCII characters are found (except for such ISO-2022 control characters ISO-2022 as ESC), it returns a list of single element @@ -6729,288 +7570,157 @@ highest priority. */) CHECK_STRING (string); return detect_coding_system (SDATA (string), - /* "+ 1" is to include the anchor byte - `\0'. With this, code detectors can - handle the tailing bytes more - accurately. */ - SBYTES (string) + 1, - !NILP (highest), - STRING_MULTIBYTE (string)); + SCHARS (string), SBYTES (string), + !NILP (highest), STRING_MULTIBYTE (string), + Qnil); } -/* Subroutine for Ffind_coding_systems_region_internal. - - Return a list of coding systems that safely encode the multibyte - text between P and PEND. SAFE_CODINGS, if non-nil, is an alist of - possible coding systems. If it is nil, it means that we have not - yet found any coding systems. - - WORK_TABLE a char-table of which element is set to t once the - element is looked up. - If a non-ASCII single byte char is found, set - *single_byte_char_found to 1. */ - -static Lisp_Object -find_safe_codings (p, pend, safe_codings, work_table, single_byte_char_found) - unsigned char *p, *pend; - Lisp_Object safe_codings, work_table; - int *single_byte_char_found; +static INLINE int +char_encodable_p (c, attrs) + int c; + Lisp_Object attrs; { - int c, len; - Lisp_Object val, ch; - Lisp_Object prev, tail; + Lisp_Object tail; + struct charset *charset; + Lisp_Object translation_table; - if (NILP (safe_codings)) - goto done_safe_codings; - while (p < pend) + translation_table = CODING_ATTR_TRANS_TBL (attrs); + if (! NILP (translation_table)) + c = translate_char (translation_table, c); + for (tail = CODING_ATTR_CHARSET_LIST (attrs); + CONSP (tail); tail = XCDR (tail)) { - c = STRING_CHAR_AND_LENGTH (p, pend - p, len); - p += len; - if (ASCII_BYTE_P (c)) - /* We can ignore ASCII characters here. */ - continue; - if (SINGLE_BYTE_CHAR_P (c)) - *single_byte_char_found = 1; - /* Check the safe coding systems for C. */ - ch = make_number (c); - val = Faref (work_table, ch); - if (EQ (val, Qt)) - /* This element was already checked. Ignore it. */ - continue; - /* Remember that we checked this element. */ - Faset (work_table, ch, Qt); - - for (prev = tail = safe_codings; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object elt, translation_table, hash_table, accept_latin_extra; - int encodable; - - elt = XCAR (tail); - if (CONSP (XCDR (elt))) - { - /* This entry has this format now: - ( CODING SAFE-CHARS TRANSLATION-TABLE HASH-TABLE - ACCEPT-LATIN-EXTRA ) */ - val = XCDR (elt); - encodable = ! NILP (Faref (XCAR (val), ch)); - if (! encodable) - { - val = XCDR (val); - translation_table = XCAR (val); - hash_table = XCAR (XCDR (val)); - accept_latin_extra = XCAR (XCDR (XCDR (val))); - } - } - else - { - /* This entry has this format now: ( CODING . SAFE-CHARS) */ - encodable = ! NILP (Faref (XCDR (elt), ch)); - if (! encodable) - { - /* Transform the format to: - ( CODING SAFE-CHARS TRANSLATION-TABLE HASH-TABLE - ACCEPT-LATIN-EXTRA ) */ - val = Fget (XCAR (elt), Qcoding_system); - translation_table - = Fplist_get (AREF (val, 3), - Qtranslation_table_for_encode); - if (SYMBOLP (translation_table)) - translation_table = Fget (translation_table, - Qtranslation_table); - hash_table - = (CHAR_TABLE_P (translation_table) - ? XCHAR_TABLE (translation_table)->extras[1] - : Qnil); - accept_latin_extra - = ((EQ (AREF (val, 0), make_number (2)) - && VECTORP (AREF (val, 4))) - ? AREF (AREF (val, 4), 16) - : Qnil); - XSETCAR (tail, list5 (XCAR (elt), XCDR (elt), - translation_table, hash_table, - accept_latin_extra)); - } - } - - if (! encodable - && ((CHAR_TABLE_P (translation_table) - && ! NILP (Faref (translation_table, ch))) - || (HASH_TABLE_P (hash_table) - && ! NILP (Fgethash (ch, hash_table, Qnil))) - || (SINGLE_BYTE_CHAR_P (c) - && ! NILP (accept_latin_extra) - && VECTORP (Vlatin_extra_code_table) - && ! NILP (AREF (Vlatin_extra_code_table, c))))) - encodable = 1; - if (encodable) - prev = tail; - else - { - /* Exclude this coding system from SAFE_CODINGS. */ - if (EQ (tail, safe_codings)) - { - safe_codings = XCDR (safe_codings); - if (NILP (safe_codings)) - goto done_safe_codings; - } - else - XSETCDR (prev, XCDR (tail)); - } - } + charset = CHARSET_FROM_ID (XINT (XCAR (tail))); + if (CHAR_CHARSET_P (c, charset)) + break; } - - done_safe_codings: - /* If the above loop was terminated before P reaches PEND, it means - SAFE_CODINGS was set to nil. If we have not yet found an - non-ASCII single-byte char, check it now. */ - if (! *single_byte_char_found) - while (p < pend) - { - c = STRING_CHAR_AND_LENGTH (p, pend - p, len); - p += len; - if (! ASCII_BYTE_P (c) - && SINGLE_BYTE_CHAR_P (c)) - { - *single_byte_char_found = 1; - break; - } - } - return safe_codings; + return (! NILP (tail)); } + +/* Return a list of coding systems that safely encode the text between + START and END. If EXCLUDE is non-nil, it is a list of coding + systems not to check. The returned list doesn't contain any such + coding systems. In any case, if the text contains only ASCII or is + unibyte, return t. */ + DEFUN ("find-coding-systems-region-internal", Ffind_coding_systems_region_internal, - Sfind_coding_systems_region_internal, 2, 2, 0, + Sfind_coding_systems_region_internal, 2, 3, 0, doc: /* Internal use only. */) - (start, end) - Lisp_Object start, end; + (start, end, exclude) + Lisp_Object start, end, exclude; { - Lisp_Object work_table, safe_codings; - int non_ascii_p = 0; - int single_byte_char_found = 0; - const unsigned char *p1, *p1end, *p2, *p2end, *p; + Lisp_Object coding_attrs_list, safe_codings; + EMACS_INT start_byte, end_byte; + const unsigned char *p, *pbeg, *pend; + int c; + Lisp_Object tail, elt; if (STRINGP (start)) { - if (!STRING_MULTIBYTE (start)) + if (!STRING_MULTIBYTE (start) + || SCHARS (start) == SBYTES (start)) return Qt; - p1 = SDATA (start), p1end = p1 + SBYTES (start); - p2 = p2end = p1end; - if (SCHARS (start) != SBYTES (start)) - non_ascii_p = 1; + start_byte = 0; + end_byte = SBYTES (start); } else { - int from, to, stop; - CHECK_NUMBER_COERCE_MARKER (start); CHECK_NUMBER_COERCE_MARKER (end); if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) args_out_of_range (start, end); if (NILP (current_buffer->enable_multibyte_characters)) return Qt; - from = CHAR_TO_BYTE (XINT (start)); - to = CHAR_TO_BYTE (XINT (end)); - stop = from < GPT_BYTE && GPT_BYTE < to ? GPT_BYTE : to; - p1 = BYTE_POS_ADDR (from), p1end = p1 + (stop - from); - if (stop == to) - p2 = p2end = p1end; - else - p2 = BYTE_POS_ADDR (stop), p2end = p2 + (to - stop); - if (XINT (end) - XINT (start) != to - from) - non_ascii_p = 1; - } + start_byte = CHAR_TO_BYTE (XINT (start)); + end_byte = CHAR_TO_BYTE (XINT (end)); + if (XINT (end) - XINT (start) == end_byte - start_byte) + return Qt; - if (!non_ascii_p) - { - /* We are sure that the text contains no multibyte character. - Check if it contains eight-bit-graphic. */ - p = p1; - for (p = p1; p < p1end && ASCII_BYTE_P (*p); p++); - if (p == p1end) + if (XINT (start) < GPT && XINT (end) > GPT) { - for (p = p2; p < p2end && ASCII_BYTE_P (*p); p++); - if (p == p2end) - return Qt; + if ((GPT - XINT (start)) < (XINT (end) - GPT)) + move_gap_both (XINT (start), start_byte); + else + move_gap_both (XINT (end), end_byte); } } - /* The text contains non-ASCII characters. */ + coding_attrs_list = Qnil; + for (tail = Vcoding_system_list; CONSP (tail); tail = XCDR (tail)) + if (NILP (exclude) + || NILP (Fmemq (XCAR (tail), exclude))) + { + Lisp_Object attrs; - work_table = Fmake_char_table (Qchar_coding_system, Qnil); - safe_codings = Fcopy_sequence (XCDR (Vcoding_system_safe_chars)); + attrs = AREF (CODING_SYSTEM_SPEC (XCAR (tail)), 0); + if (EQ (XCAR (tail), CODING_ATTR_BASE_NAME (attrs)) + && ! EQ (CODING_ATTR_TYPE (attrs), Qundecided)) + { + ASET (attrs, coding_attr_trans_tbl, + get_translation_table (attrs, 1, NULL)); + coding_attrs_list = Fcons (attrs, coding_attrs_list); + } + } - safe_codings = find_safe_codings (p1, p1end, safe_codings, work_table, - &single_byte_char_found); - if (p2 < p2end) - safe_codings = find_safe_codings (p2, p2end, safe_codings, work_table, - &single_byte_char_found); - if (EQ (safe_codings, XCDR (Vcoding_system_safe_chars))) - safe_codings = Qt; + if (STRINGP (start)) + p = pbeg = SDATA (start); else - { - /* Turn safe_codings to a list of coding systems... */ - Lisp_Object val; - - if (single_byte_char_found) - /* ... and append these for eight-bit chars. */ - val = Fcons (Qraw_text, - Fcons (Qemacs_mule, Fcons (Qno_conversion, Qnil))); - else - /* ... and append generic coding systems. */ - val = Fcopy_sequence (XCAR (Vcoding_system_safe_chars)); - - for (; CONSP (safe_codings); safe_codings = XCDR (safe_codings)) - val = Fcons (XCAR (XCAR (safe_codings)), val); - safe_codings = val; - } - - return safe_codings; -} - - -/* Search from position POS for such characters that are unencodable - accoding to SAFE_CHARS, and return a list of their positions. P - points where in the memory the character at POS exists. Limit the - search at PEND or when Nth unencodable characters are found. + p = pbeg = BYTE_POS_ADDR (start_byte); + pend = p + (end_byte - start_byte); - If SAFE_CHARS is a char table, an element for an unencodable - character is nil. + while (p < pend && ASCII_BYTE_P (*p)) p++; + while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--; - If SAFE_CHARS is nil, all non-ASCII characters are unencodable. - - Otherwise, SAFE_CHARS is t, and only eight-bit-contrl and - eight-bit-graphic characters are unencodable. */ - -static Lisp_Object -unencodable_char_position (safe_chars, pos, p, pend, n) - Lisp_Object safe_chars; - int pos; - unsigned char *p, *pend; - int n; -{ - Lisp_Object pos_list; - - pos_list = Qnil; while (p < pend) { - int len; - int c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len); - - if (c >= 128 - && (CHAR_TABLE_P (safe_chars) - ? NILP (CHAR_TABLE_REF (safe_chars, c)) - : (NILP (safe_chars) || c < 256))) + if (ASCII_BYTE_P (*p)) + p++; + else { - pos_list = Fcons (make_number (pos), pos_list); - if (--n <= 0) - break; + c = STRING_CHAR_ADVANCE (p); + + charset_map_loaded = 0; + for (tail = coding_attrs_list; CONSP (tail);) + { + elt = XCAR (tail); + if (NILP (elt)) + tail = XCDR (tail); + else if (char_encodable_p (c, elt)) + tail = XCDR (tail); + else if (CONSP (XCDR (tail))) + { + XSETCAR (tail, XCAR (XCDR (tail))); + XSETCDR (tail, XCDR (XCDR (tail))); + } + else + { + XSETCAR (tail, Qnil); + tail = XCDR (tail); + } + } + if (charset_map_loaded) + { + EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg; + + if (STRINGP (start)) + pbeg = SDATA (start); + else + pbeg = BYTE_POS_ADDR (start_byte); + p = pbeg + p_offset; + pend = pbeg + pend_offset; + } } - pos++; - p += len; } - return Fnreverse (pos_list); + + safe_codings = list2 (Qraw_text, Qno_conversion); + for (tail = coding_attrs_list; CONSP (tail); tail = XCDR (tail)) + if (! NILP (XCAR (tail))) + safe_codings = Fcons (CODING_ATTR_BASE_NAME (XCAR (tail)), safe_codings); + + return safe_codings; } @@ -7032,24 +7742,36 @@ to the string. */) Lisp_Object start, end, coding_system, count, string; { int n; - Lisp_Object safe_chars; struct coding_system coding; + Lisp_Object attrs, charset_list, translation_table; Lisp_Object positions; int from, to; - unsigned char *p, *pend; + const unsigned char *p, *stop, *pend; + int ascii_compatible; + + setup_coding_system (Fcheck_coding_system (coding_system), &coding); + attrs = CODING_ID_ATTRS (coding.id); + if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text)) + return Qnil; + ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)); + charset_list = CODING_ATTR_CHARSET_LIST (attrs); + translation_table = get_translation_table (attrs, 1, NULL); if (NILP (string)) { validate_region (&start, &end); from = XINT (start); to = XINT (end); - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (current_buffer->enable_multibyte_characters) + || (ascii_compatible + && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from))))) return Qnil; p = CHAR_POS_ADDR (from); - if (to == GPT) - pend = GPT_ADDR; + pend = CHAR_POS_ADDR (to); + if (from < GPT && to >= GPT) + stop = GPT_ADDR; else - pend = CHAR_POS_ADDR (to); + stop = pend; } else { @@ -7064,11 +7786,11 @@ to the string. */) if (! STRING_MULTIBYTE (string)) return Qnil; p = SDATA (string) + string_char_to_byte (string, from); - pend = SDATA (string) + string_char_to_byte (string, to); + stop = pend = SDATA (string) + string_char_to_byte (string, to); + if (ascii_compatible && (to - from) == (pend - p)) + return Qnil; } - setup_coding_system (Fcheck_coding_system (coding_system), &coding); - if (NILP (count)) n = 1; else @@ -7077,151 +7799,294 @@ to the string. */) n = XINT (count); } - if (coding.type == coding_type_no_conversion - || coding.type == coding_type_raw_text) - return Qnil; + positions = Qnil; + while (1) + { + int c; + + if (ascii_compatible) + while (p < stop && ASCII_BYTE_P (*p)) + p++, from++; + if (p >= stop) + { + if (p >= pend) + break; + stop = pend; + p = GAP_END_ADDR; + } + + c = STRING_CHAR_ADVANCE (p); + if (! (ASCII_CHAR_P (c) && ascii_compatible) + && ! char_charset (translate_char (translation_table, c), + charset_list, NULL)) + { + positions = Fcons (make_number (from), positions); + n--; + if (n == 0) + break; + } + + from++; + } + + return (NILP (count) ? Fcar (positions) : Fnreverse (positions)); +} - if (coding.type == coding_type_undecided) - safe_chars = Qnil; - else - safe_chars = coding_safe_chars (coding_system); - if (STRINGP (string) - || from >= GPT || to <= GPT) - positions = unencodable_char_position (safe_chars, from, p, pend, n); +DEFUN ("check-coding-systems-region", Fcheck_coding_systems_region, + Scheck_coding_systems_region, 3, 3, 0, + doc: /* Check if the region is encodable by coding systems. + +START and END are buffer positions specifying the region. +CODING-SYSTEM-LIST is a list of coding systems to check. + +The value is an alist ((CODING-SYSTEM POS0 POS1 ...) ...), where +CODING-SYSTEM is a member of CODING-SYSTEM-LIst and can't encode the +whole region, POS0, POS1, ... are buffer positions where non-encodable +characters are found. + +If all coding systems in CODING-SYSTEM-LIST can encode the region, the +value is nil. + +START may be a string. In that case, check if the string is +encodable, and the value contains indices to the string instead of +buffer positions. END is ignored. */) + (start, end, coding_system_list) + Lisp_Object start, end, coding_system_list; +{ + Lisp_Object list; + EMACS_INT start_byte, end_byte; + int pos; + const unsigned char *p, *pbeg, *pend; + int c; + Lisp_Object tail, elt, attrs; + + if (STRINGP (start)) + { + if (!STRING_MULTIBYTE (start) + && SCHARS (start) != SBYTES (start)) + return Qnil; + start_byte = 0; + end_byte = SBYTES (start); + pos = 0; + } else { - Lisp_Object args[2]; + CHECK_NUMBER_COERCE_MARKER (start); + CHECK_NUMBER_COERCE_MARKER (end); + if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) + args_out_of_range (start, end); + if (NILP (current_buffer->enable_multibyte_characters)) + return Qnil; + start_byte = CHAR_TO_BYTE (XINT (start)); + end_byte = CHAR_TO_BYTE (XINT (end)); + if (XINT (end) - XINT (start) == end_byte - start_byte) + return Qt; + + if (XINT (start) < GPT && XINT (end) > GPT) + { + if ((GPT - XINT (start)) < (XINT (end) - GPT)) + move_gap_both (XINT (start), start_byte); + else + move_gap_both (XINT (end), end_byte); + } + pos = XINT (start); + } + + list = Qnil; + for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + attrs = AREF (CODING_SYSTEM_SPEC (elt), 0); + ASET (attrs, coding_attr_trans_tbl, + get_translation_table (attrs, 1, NULL)); + list = Fcons (Fcons (elt, Fcons (attrs, Qnil)), list); + } + + if (STRINGP (start)) + p = pbeg = SDATA (start); + else + p = pbeg = BYTE_POS_ADDR (start_byte); + pend = p + (end_byte - start_byte); + + while (p < pend && ASCII_BYTE_P (*p)) p++, pos++; + while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--; - args[0] = unencodable_char_position (safe_chars, from, p, GPT_ADDR, n); - n -= XINT (Flength (args[0])); - if (n <= 0) - positions = args[0]; + while (p < pend) + { + if (ASCII_BYTE_P (*p)) + p++; else { - args[1] = unencodable_char_position (safe_chars, GPT, GAP_END_ADDR, - pend, n); - positions = Fappend (2, args); + c = STRING_CHAR_ADVANCE (p); + + charset_map_loaded = 0; + for (tail = list; CONSP (tail); tail = XCDR (tail)) + { + elt = XCDR (XCAR (tail)); + if (! char_encodable_p (c, XCAR (elt))) + XSETCDR (elt, Fcons (make_number (pos), XCDR (elt))); + } + if (charset_map_loaded) + { + EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg; + + if (STRINGP (start)) + pbeg = SDATA (start); + else + pbeg = BYTE_POS_ADDR (start_byte); + p = pbeg + p_offset; + pend = pbeg + pend_offset; + } } + pos++; + } + + tail = list; + list = Qnil; + for (; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + if (CONSP (XCDR (XCDR (elt)))) + list = Fcons (Fcons (XCAR (elt), Fnreverse (XCDR (XCDR (elt)))), + list); } - return (NILP (count) ? Fcar (positions) : positions); + return list; } Lisp_Object -code_convert_region1 (start, end, coding_system, encodep) - Lisp_Object start, end, coding_system; - int encodep; +code_convert_region (start, end, coding_system, dst_object, encodep, norecord) + Lisp_Object start, end, coding_system, dst_object; + int encodep, norecord; { struct coding_system coding; - int from, to; + EMACS_INT from, from_byte, to, to_byte; + Lisp_Object src_object; CHECK_NUMBER_COERCE_MARKER (start); CHECK_NUMBER_COERCE_MARKER (end); - CHECK_SYMBOL (coding_system); + if (NILP (coding_system)) + coding_system = Qno_conversion; + else + CHECK_CODING_SYSTEM (coding_system); + src_object = Fcurrent_buffer (); + if (NILP (dst_object)) + dst_object = src_object; + else if (! EQ (dst_object, Qt)) + CHECK_BUFFER (dst_object); validate_region (&start, &end); from = XFASTINT (start); + from_byte = CHAR_TO_BYTE (from); to = XFASTINT (end); + to_byte = CHAR_TO_BYTE (to); - if (NILP (coding_system)) - return make_number (to - from); - - if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0) - error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system))); - + setup_coding_system (coding_system, &coding); coding.mode |= CODING_MODE_LAST_BLOCK; - coding.src_multibyte = coding.dst_multibyte - = !NILP (current_buffer->enable_multibyte_characters); - code_convert_region (from, CHAR_TO_BYTE (from), to, CHAR_TO_BYTE (to), - &coding, encodep, 1); - Vlast_coding_system_used = coding.symbol; - return make_number (coding.produced_char); + + if (encodep) + encode_coding_object (&coding, src_object, from, from_byte, to, to_byte, + dst_object); + else + decode_coding_object (&coding, src_object, from, from_byte, to, to_byte, + dst_object); + if (! norecord) + Vlast_coding_system_used = CODING_ID_NAME (coding.id); + + return (BUFFERP (dst_object) + ? make_number (coding.produced_char) + : coding.dst_object); } + DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region, - 3, 3, "r\nzCoding system: ", + 3, 4, "r\nzCoding system: ", doc: /* Decode the current region from the specified coding system. -When called from a program, takes three arguments: -START, END, and CODING-SYSTEM. START and END are buffer positions. +When called from a program, takes four arguments: + START, END, CODING-SYSTEM, and DESTINATION. +START and END are buffer positions. + +Optional 4th arguments DESTINATION specifies where the decoded text goes. +If nil, the region between START and END is replaced by the decoded text. +If buffer, the decoded text is inserted in the buffer. +If t, the decoded text is returned. + This function sets `last-coding-system-used' to the precise coding system used (which may be different from CODING-SYSTEM if CODING-SYSTEM is not fully specified.) It returns the length of the decoded text. */) - (start, end, coding_system) - Lisp_Object start, end, coding_system; + (start, end, coding_system, destination) + Lisp_Object start, end, coding_system, destination; { - return code_convert_region1 (start, end, coding_system, 0); + return code_convert_region (start, end, coding_system, destination, 0, 0); } DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region, - 3, 3, "r\nzCoding system: ", - doc: /* Encode the current region into the specified coding system. + 3, 4, "r\nzCoding system: ", + doc: /* Encode the current region by specified coding system. When called from a program, takes three arguments: START, END, and CODING-SYSTEM. START and END are buffer positions. + +Optional 4th arguments DESTINATION specifies where the encoded text goes. +If nil, the region between START and END is replace by the encoded text. +If buffer, the encoded text is inserted in the buffer. +If t, the encoded text is returned. + This function sets `last-coding-system-used' to the precise coding system used (which may be different from CODING-SYSTEM if CODING-SYSTEM is not fully specified.) It returns the length of the encoded text. */) - (start, end, coding_system) - Lisp_Object start, end, coding_system; + (start, end, coding_system, destination) + Lisp_Object start, end, coding_system, destination; { - return code_convert_region1 (start, end, coding_system, 1); + return code_convert_region (start, end, coding_system, destination, 1, 0); } Lisp_Object -code_convert_string1 (string, coding_system, nocopy, encodep) - Lisp_Object string, coding_system, nocopy; - int encodep; +code_convert_string (string, coding_system, dst_object, + encodep, nocopy, norecord) + Lisp_Object string, coding_system, dst_object; + int encodep, nocopy, norecord; { struct coding_system coding; + EMACS_INT chars, bytes; CHECK_STRING (string); - CHECK_SYMBOL (coding_system); - if (NILP (coding_system)) - return (NILP (nocopy) ? Fcopy_sequence (string) : string); + { + if (! norecord) + Vlast_coding_system_used = Qno_conversion; + if (NILP (dst_object)) + return (nocopy ? Fcopy_sequence (string) : string); + } - if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0) - error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system))); + if (NILP (coding_system)) + coding_system = Qno_conversion; + else + CHECK_CODING_SYSTEM (coding_system); + if (NILP (dst_object)) + dst_object = Qt; + else if (! EQ (dst_object, Qt)) + CHECK_BUFFER (dst_object); + setup_coding_system (coding_system, &coding); coding.mode |= CODING_MODE_LAST_BLOCK; - string = (encodep - ? encode_coding_string (string, &coding, !NILP (nocopy)) - : decode_coding_string (string, &coding, !NILP (nocopy))); - Vlast_coding_system_used = coding.symbol; + chars = SCHARS (string); + bytes = SBYTES (string); + if (encodep) + encode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object); + else + decode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object); + if (! norecord) + Vlast_coding_system_used = CODING_ID_NAME (coding.id); - return string; + return (BUFFERP (dst_object) + ? make_number (coding.produced_char) + : coding.dst_object); } -DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string, - 2, 3, 0, - doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result. -Optional arg NOCOPY non-nil means it is OK to return STRING itself -if the decoding operation is trivial. -This function sets `last-coding-system-used' to the precise coding system -used (which may be different from CODING-SYSTEM if CODING-SYSTEM is -not fully specified.) */) - (string, coding_system, nocopy) - Lisp_Object string, coding_system, nocopy; -{ - return code_convert_string1 (string, coding_system, nocopy, 0); -} - -DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string, - 2, 3, 0, - doc: /* Encode STRING to CODING-SYSTEM, and return the result. -Optional arg NOCOPY non-nil means it is OK to return STRING itself -if the encoding operation is trivial. -This function sets `last-coding-system-used' to the precise coding system -used (which may be different from CODING-SYSTEM if CODING-SYSTEM is -not fully specified.) */) - (string, coding_system, nocopy) - Lisp_Object string, coding_system, nocopy; -{ - return code_convert_string1 (string, coding_system, nocopy, 1); -} /* Encode or decode STRING according to CODING_SYSTEM. Do not set Vlast_coding_system_used. @@ -7234,23 +8099,52 @@ code_convert_string_norecord (string, coding_system, encodep) Lisp_Object string, coding_system; int encodep; { - struct coding_system coding; + return code_convert_string (string, coding_system, Qt, encodep, 0, 1); +} - CHECK_STRING (string); - CHECK_SYMBOL (coding_system); - if (NILP (coding_system)) - return string; +DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string, + 2, 4, 0, + doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result. - if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0) - error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system))); +Optional third arg NOCOPY non-nil means it is OK to return STRING itself +if the decoding operation is trivial. - coding.composing = COMPOSITION_DISABLED; - coding.mode |= CODING_MODE_LAST_BLOCK; - return (encodep - ? encode_coding_string (string, &coding, 1) - : decode_coding_string (string, &coding, 1)); +Optional fourth arg BUFFER non-nil meant that the decoded text is +inserted in BUFFER instead of returned as a string. In this case, +the return value is BUFFER. + +This function sets `last-coding-system-used' to the precise coding system +used (which may be different from CODING-SYSTEM if CODING-SYSTEM is +not fully specified. */) + (string, coding_system, nocopy, buffer) + Lisp_Object string, coding_system, nocopy, buffer; +{ + return code_convert_string (string, coding_system, buffer, + 0, ! NILP (nocopy), 0); } + +DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string, + 2, 4, 0, + doc: /* Encode STRING to CODING-SYSTEM, and return the result. + +Optional third arg NOCOPY non-nil means it is OK to return STRING +itself if the encoding operation is trivial. + +Optional fourth arg BUFFER non-nil meant that the encoded text is +inserted in BUFFER instead of returned as a string. In this case, +the return value is BUFFER. + +This function sets `last-coding-system-used' to the precise coding system +used (which may be different from CODING-SYSTEM if CODING-SYSTEM is +not fully specified.) */) + (string, coding_system, nocopy, buffer) + Lisp_Object string, coding_system, nocopy, buffer; +{ + return code_convert_string (string, coding_system, buffer, + 1, ! NILP (nocopy), 1); +} + DEFUN ("decode-sjis-char", Fdecode_sjis_char, Sdecode_sjis_char, 1, 1, 0, doc: /* Decode a Japanese character which has CODE in shift_jis encoding. @@ -7258,60 +8152,75 @@ Return the corresponding character. */) (code) Lisp_Object code; { - unsigned char c1, c2, s1, s2; - Lisp_Object val; + Lisp_Object spec, attrs, val; + struct charset *charset_roman, *charset_kanji, *charset_kana, *charset; + int c; + + CHECK_NATNUM (code); + c = XFASTINT (code); + CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec); + attrs = AREF (spec, 0); - CHECK_NUMBER (code); - s1 = (XFASTINT (code)) >> 8, s2 = (XFASTINT (code)) & 0xFF; - if (s1 == 0) + if (ASCII_BYTE_P (c) + && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs))) + return code; + + val = CODING_ATTR_CHARSET_LIST (attrs); + charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))); + + if (c <= 0x7F) + charset = charset_roman; + else if (c >= 0xA0 && c < 0xDF) { - if (s2 < 0x80) - XSETFASTINT (val, s2); - else if (s2 >= 0xA0 || s2 <= 0xDF) - XSETFASTINT (val, MAKE_CHAR (charset_katakana_jisx0201, s2, 0)); - else - error ("Invalid Shift JIS code: %x", XFASTINT (code)); + charset = charset_kana; + c -= 0x80; } else { - if ((s1 < 0x80 || (s1 > 0x9F && s1 < 0xE0) || s1 > 0xEF) - || (s2 < 0x40 || s2 == 0x7F || s2 > 0xFC)) - error ("Invalid Shift JIS code: %x", XFASTINT (code)); - DECODE_SJIS (s1, s2, c1, c2); - XSETFASTINT (val, MAKE_CHAR (charset_jisx0208, c1, c2)); + int s1 = c >> 8, s2 = c & 0xFF; + + if (s1 < 0x81 || (s1 > 0x9F && s1 < 0xE0) || s1 > 0xEF + || s2 < 0x40 || s2 == 0x7F || s2 > 0xFC) + error ("Invalid code: %d", code); + SJIS_TO_JIS (c); + charset = charset_kanji; } - return val; + c = DECODE_CHAR (charset, c); + if (c < 0) + error ("Invalid code: %d", code); + return make_number (c); } + DEFUN ("encode-sjis-char", Fencode_sjis_char, Sencode_sjis_char, 1, 1, 0, doc: /* Encode a Japanese character CH to shift_jis encoding. Return the corresponding code in SJIS. */) (ch) - Lisp_Object ch; + Lisp_Object ch; { - int charset, c1, c2, s1, s2; - Lisp_Object val; + Lisp_Object spec, attrs, charset_list; + int c; + struct charset *charset; + unsigned code; - CHECK_NUMBER (ch); - SPLIT_CHAR (XFASTINT (ch), charset, c1, c2); - if (charset == CHARSET_ASCII) - { - val = ch; - } - else if (charset == charset_jisx0208 - && c1 > 0x20 && c1 < 0x7F && c2 > 0x20 && c2 < 0x7F) - { - ENCODE_SJIS (c1, c2, s1, s2); - XSETFASTINT (val, (s1 << 8) | s2); - } - else if (charset == charset_katakana_jisx0201 - && c1 > 0x20 && c2 < 0xE0) - { - XSETFASTINT (val, c1 | 0x80); - } - else - error ("Can't encode to shift_jis: %d", XFASTINT (ch)); - return val; + CHECK_CHARACTER (ch); + c = XFASTINT (ch); + CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec); + attrs = AREF (spec, 0); + + if (ASCII_CHAR_P (c) + && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs))) + return ch; + + charset_list = CODING_ATTR_CHARSET_LIST (attrs); + charset = char_charset (c, charset_list, &code); + if (code == CHARSET_INVALID_CODE (charset)) + error ("Can't encode by shift_jis encoding: %d", c); + JIS_TO_SJIS (code); + + return make_number (code); } DEFUN ("decode-big5-char", Fdecode_big5_char, Sdecode_big5_char, 1, 1, 0, @@ -7320,27 +8229,37 @@ Return the corresponding character. */) (code) Lisp_Object code; { - int charset; - unsigned char b1, b2, c1, c2; - Lisp_Object val; + Lisp_Object spec, attrs, val; + struct charset *charset_roman, *charset_big5, *charset; + int c; - CHECK_NUMBER (code); - b1 = (XFASTINT (code)) >> 8, b2 = (XFASTINT (code)) & 0xFF; - if (b1 == 0) - { - if (b2 >= 0x80) - error ("Invalid BIG5 code: %x", XFASTINT (code)); - val = code; - } + CHECK_NATNUM (code); + c = XFASTINT (code); + CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec); + attrs = AREF (spec, 0); + + if (ASCII_BYTE_P (c) + && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs))) + return code; + + val = CODING_ATTR_CHARSET_LIST (attrs); + charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val); + charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val))); + + if (c <= 0x7F) + charset = charset_roman; else { - if ((b1 < 0xA1 || b1 > 0xFE) - || (b2 < 0x40 || (b2 > 0x7E && b2 < 0xA1) || b2 > 0xFE)) - error ("Invalid BIG5 code: %x", XFASTINT (code)); - DECODE_BIG5 (b1, b2, charset, c1, c2); - XSETFASTINT (val, MAKE_CHAR (charset, c1, c2)); + int b1 = c >> 8, b2 = c & 0x7F; + if (b1 < 0xA1 || b1 > 0xFE + || b2 < 0x40 || (b2 > 0x7E && b2 < 0xA1) || b2 > 0xFE) + error ("Invalid code: %d", code); + charset = charset_big5; } - return val; + c = DECODE_CHAR (charset, (unsigned )c); + if (c < 0) + error ("Invalid code: %d", code); + return make_number (c); } DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0, @@ -7349,27 +8268,27 @@ Return the corresponding character code in Big5. */) (ch) Lisp_Object ch; { - int charset, c1, c2, b1, b2; - Lisp_Object val; - - CHECK_NUMBER (ch); - SPLIT_CHAR (XFASTINT (ch), charset, c1, c2); - if (charset == CHARSET_ASCII) - { - val = ch; - } - else if ((charset == charset_big5_1 - && (XFASTINT (ch) >= 0x250a1 && XFASTINT (ch) <= 0x271ec)) - || (charset == charset_big5_2 - && XFASTINT (ch) >= 0x290a1 && XFASTINT (ch) <= 0x2bdb2)) - { - ENCODE_BIG5 (charset, c1, c2, b1, b2); - XSETFASTINT (val, (b1 << 8) | b2); - } - else - error ("Can't encode to Big5: %d", XFASTINT (ch)); - return val; + Lisp_Object spec, attrs, charset_list; + struct charset *charset; + int c; + unsigned code; + + CHECK_CHARACTER (ch); + c = XFASTINT (ch); + CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec); + attrs = AREF (spec, 0); + if (ASCII_CHAR_P (c) + && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs))) + return ch; + + charset_list = CODING_ATTR_CHARSET_LIST (attrs); + charset = char_charset (c, charset_list, &code); + if (code == CHARSET_INVALID_CODE (charset)) + error ("Can't encode by Big5 encoding: %d", c); + + return make_number (code); } + DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_internal, Sset_terminal_coding_system_internal, 1, 2, 0, @@ -7382,17 +8301,16 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern CHECK_SYMBOL (coding_system); setup_coding_system (Fcheck_coding_system (coding_system), terminal_coding); /* We had better not send unsafe characters to terminal. */ - terminal_coding->mode |= CODING_MODE_INHIBIT_UNENCODABLE_CHAR; - /* Character composition should be disabled. */ - terminal_coding->composing = COMPOSITION_DISABLED; - /* Error notification should be suppressed. */ - terminal_coding->suppress_error = 1; + terminal_coding->mode |= CODING_MODE_SAFE_ENCODING; + /* Characer composition should be disabled. */ + terminal_coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK; terminal_coding->src_multibyte = 1; terminal_coding->dst_multibyte = 0; return Qnil; } -DEFUN ("set-safe-terminal-coding-system-internal", Fset_safe_terminal_coding_system_internal, +DEFUN ("set-safe-terminal-coding-system-internal", + Fset_safe_terminal_coding_system_internal, Sset_safe_terminal_coding_system_internal, 1, 1, 0, doc: /* Internal use only. */) (coding_system) @@ -7401,10 +8319,8 @@ DEFUN ("set-safe-terminal-coding-system-internal", Fset_safe_terminal_coding_sys CHECK_SYMBOL (coding_system); setup_coding_system (Fcheck_coding_system (coding_system), &safe_terminal_coding); - /* Character composition should be disabled. */ - safe_terminal_coding.composing = COMPOSITION_DISABLED; - /* Error notification should be suppressed. */ - safe_terminal_coding.suppress_error = 1; + /* Characer composition should be disabled. */ + safe_terminal_coding.common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK; safe_terminal_coding.src_multibyte = 1; safe_terminal_coding.dst_multibyte = 0; return Qnil; @@ -7418,7 +8334,12 @@ frame's terminal device. */) (terminal) Lisp_Object terminal; { - return TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1))->symbol; + struct coding_system *terminal_coding + = TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1)); + Lisp_Object coding_system = CODING_ID_NAME (terminal_coding->id); + + /* For backward compatibility, return nil if it is `undecided'. */ + return (! EQ (coding_system, Qundecided) ? coding_system : Qnil); } DEFUN ("set-keyboard-coding-system-internal", Fset_keyboard_coding_system_internal, @@ -7430,23 +8351,22 @@ DEFUN ("set-keyboard-coding-system-internal", Fset_keyboard_coding_system_intern { struct terminal *t = get_terminal (terminal, 1); CHECK_SYMBOL (coding_system); - setup_coding_system (Fcheck_coding_system (coding_system), - TERMINAL_KEYBOARD_CODING (t)); - /* Character composition should be disabled. */ - TERMINAL_KEYBOARD_CODING (t)->composing = COMPOSITION_DISABLED; + TERMINAL_KEYBOARD_CODING (t)); + /* Characer composition should be disabled. */ + TERMINAL_KEYBOARD_CODING (t)->common_flags + &= ~CODING_ANNOTATE_COMPOSITION_MASK; return Qnil; } -DEFUN ("keyboard-coding-system", Fkeyboard_coding_system, - Skeyboard_coding_system, 0, 1, 0, - doc: /* Return coding system for decoding keyboard input on TERMINAL. -TERMINAL may be a terminal id, a frame, or nil for the selected -frame's terminal device. */) +DEFUN ("keyboard-coding-system", + Fkeyboard_coding_system, Skeyboard_coding_system, 0, 1, 0, + doc: /* Return coding system specified for decoding keyboard input. */) (terminal) Lisp_Object terminal; { - return TERMINAL_KEYBOARD_CODING (get_terminal (terminal, 1))->symbol; + return CODING_ID_NAME (TERMINAL_KEYBOARD_CODING + (get_terminal (terminal, 1))->id); } @@ -7503,23 +8423,16 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) operation = args[0]; if (!SYMBOLP (operation) || !INTEGERP (target_idx = Fget (operation, Qtarget_idx))) - error ("Invalid first argument"); + error ("Invalid first arguement"); if (nargs < 1 + XINT (target_idx)) error ("Too few arguments for operation: %s", SDATA (SYMBOL_NAME (operation))); - /* For write-region, if the 6th argument (i.e. VISIT, the 5th - argument to write-region) is string, it must be treated as a - target file name. */ - if (EQ (operation, Qwrite_region) - && nargs > 5 - && STRINGP (args[5])) - target_idx = make_number (4); target = args[XINT (target_idx) + 1]; if (!(STRINGP (target) || (EQ (operation, Qinsert_file_contents) && CONSP (target) && STRINGP (XCAR (target)) && BUFFERP (XCDR (target))) || (EQ (operation, Qopen_network_stream) && INTEGERP (target)))) - error ("Invalid argument %d", XINT (target_idx) + 1); + error ("Invalid %dth argument", XINT (target_idx) + 1); if (CONSP (target)) target = XCAR (target); @@ -7535,8 +8448,8 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) for (; CONSP (chain); chain = XCDR (chain)) { Lisp_Object elt; - elt = XCAR (chain); + elt = XCAR (chain); if (CONSP (elt) && ((STRINGP (target) && STRINGP (XCAR (elt)) @@ -7569,101 +8482,799 @@ usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) return Qnil; } -DEFUN ("update-coding-systems-internal", Fupdate_coding_systems_internal, - Supdate_coding_systems_internal, 0, 0, 0, - doc: /* Update internal database for ISO2022 and CCL based coding systems. -When values of any coding categories are changed, you must -call this function. */) - () +DEFUN ("set-coding-system-priority", Fset_coding_system_priority, + Sset_coding_system_priority, 0, MANY, 0, + doc: /* Assign higher priority to the coding systems given as arguments. +If multiple coding systems belongs to the same category, +all but the first one are ignored. + +usage: (set-coding-system-priority ...) */) + (nargs, args) + int nargs; + Lisp_Object *args; { - int i; + int i, j; + int changed[coding_category_max]; + enum coding_category priorities[coding_category_max]; - for (i = CODING_CATEGORY_IDX_EMACS_MULE; i < CODING_CATEGORY_IDX_MAX; i++) + bzero (changed, sizeof changed); + + for (i = j = 0; i < nargs; i++) { - Lisp_Object val; + enum coding_category category; + Lisp_Object spec, attrs; - val = find_symbol_value (XVECTOR (Vcoding_category_table)->contents[i]); - if (!NILP (val)) - { - if (! coding_system_table[i]) - coding_system_table[i] = ((struct coding_system *) - xmalloc (sizeof (struct coding_system))); - setup_coding_system (val, coding_system_table[i]); - } - else if (coding_system_table[i]) - { - xfree (coding_system_table[i]); - coding_system_table[i] = NULL; - } + CHECK_CODING_SYSTEM_GET_SPEC (args[i], spec); + attrs = AREF (spec, 0); + category = XINT (CODING_ATTR_CATEGORY (attrs)); + if (changed[category]) + /* Ignore this coding system because a coding system of the + same category already had a higher priority. */ + continue; + changed[category] = 1; + priorities[j++] = category; + if (coding_categories[category].id >= 0 + && ! EQ (args[i], CODING_ID_NAME (coding_categories[category].id))) + setup_coding_system (args[i], &coding_categories[category]); + Fset (AREF (Vcoding_category_table, category), args[i]); + } + + /* Now we have decided top J priorities. Reflect the order of the + original priorities to the remaining priorities. */ + + for (i = j, j = 0; i < coding_category_max; i++, j++) + { + while (j < coding_category_max + && changed[coding_priorities[j]]) + j++; + if (j == coding_category_max) + abort (); + priorities[i] = coding_priorities[j]; } + bcopy (priorities, coding_priorities, sizeof priorities); + + /* Update `coding-category-list'. */ + Vcoding_category_list = Qnil; + for (i = coding_category_max - 1; i >= 0; i--) + Vcoding_category_list + = Fcons (AREF (Vcoding_category_table, priorities[i]), + Vcoding_category_list); + return Qnil; } -DEFUN ("set-coding-priority-internal", Fset_coding_priority_internal, - Sset_coding_priority_internal, 0, 0, 0, - doc: /* Update internal database for the current value of `coding-category-list'. -This function is internal use only. */) - () +DEFUN ("coding-system-priority-list", Fcoding_system_priority_list, + Scoding_system_priority_list, 0, 1, 0, + doc: /* Return a list of coding systems ordered by their priorities. +HIGHESTP non-nil means just return the highest priority one. */) + (highestp) + Lisp_Object highestp; { - int i = 0, idx; + int i; Lisp_Object val; - val = Vcoding_category_list; - - while (CONSP (val) && i < CODING_CATEGORY_IDX_MAX) + for (i = 0, val = Qnil; i < coding_category_max; i++) { - if (! SYMBOLP (XCAR (val))) - break; - idx = XFASTINT (Fget (XCAR (val), Qcoding_category_index)); - if (idx >= CODING_CATEGORY_IDX_MAX) - break; - coding_priorities[i++] = (1 << idx); - val = XCDR (val); + enum coding_category category = coding_priorities[i]; + int id = coding_categories[category].id; + Lisp_Object attrs; + + if (id < 0) + continue; + attrs = CODING_ID_ATTRS (id); + if (! NILP (highestp)) + return CODING_ATTR_BASE_NAME (attrs); + val = Fcons (CODING_ATTR_BASE_NAME (attrs), val); } - /* If coding-category-list is valid and contains all coding - categories, `i' should be CODING_CATEGORY_IDX_MAX now. If not, - the following code saves Emacs from crashing. */ - while (i < CODING_CATEGORY_IDX_MAX) - coding_priorities[i++] = CODING_CATEGORY_MASK_RAW_TEXT; + return Fnreverse (val); +} - return Qnil; +static char *suffixes[] = { "-unix", "-dos", "-mac" }; + +static Lisp_Object +make_subsidiaries (base) + Lisp_Object base; +{ + Lisp_Object subsidiaries; + int base_name_len = SBYTES (SYMBOL_NAME (base)); + char *buf = (char *) alloca (base_name_len + 6); + int i; + + bcopy (SDATA (SYMBOL_NAME (base)), buf, base_name_len); + subsidiaries = Fmake_vector (make_number (3), Qnil); + for (i = 0; i < 3; i++) + { + bcopy (suffixes[i], buf + base_name_len, strlen (suffixes[i]) + 1); + ASET (subsidiaries, i, intern (buf)); + } + return subsidiaries; } + DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal, - Sdefine_coding_system_internal, 1, 1, 0, - doc: /* Register CODING-SYSTEM as a base coding system. -This function is internal use only. */) - (coding_system) - Lisp_Object coding_system; + Sdefine_coding_system_internal, coding_arg_max, MANY, 0, + doc: /* For internal use only. +usage: (define-coding-system-internal ...) */) + (nargs, args) + int nargs; + Lisp_Object *args; { - Lisp_Object safe_chars, slot; + Lisp_Object name; + Lisp_Object spec_vec; /* [ ATTRS ALIASE EOL_TYPE ] */ + Lisp_Object attrs; /* Vector of attributes. */ + Lisp_Object eol_type; + Lisp_Object aliases; + Lisp_Object coding_type, charset_list, safe_charsets; + enum coding_category category; + Lisp_Object tail, val; + int max_charset_id = 0; + int i; + + if (nargs < coding_arg_max) + goto short_args; - if (NILP (Fcheck_coding_system (coding_system))) - xsignal1 (Qcoding_system_error, coding_system); + attrs = Fmake_vector (make_number (coding_attr_last_index), Qnil); - safe_chars = coding_safe_chars (coding_system); - if (! EQ (safe_chars, Qt) && ! CHAR_TABLE_P (safe_chars)) - error ("No valid safe-chars property for %s", - SDATA (SYMBOL_NAME (coding_system))); + name = args[coding_arg_name]; + CHECK_SYMBOL (name); + CODING_ATTR_BASE_NAME (attrs) = name; - if (EQ (safe_chars, Qt)) + val = args[coding_arg_mnemonic]; + if (! STRINGP (val)) + CHECK_CHARACTER (val); + CODING_ATTR_MNEMONIC (attrs) = val; + + coding_type = args[coding_arg_coding_type]; + CHECK_SYMBOL (coding_type); + CODING_ATTR_TYPE (attrs) = coding_type; + + charset_list = args[coding_arg_charset_list]; + if (SYMBOLP (charset_list)) { - if (NILP (Fmemq (coding_system, XCAR (Vcoding_system_safe_chars)))) - XSETCAR (Vcoding_system_safe_chars, - Fcons (coding_system, XCAR (Vcoding_system_safe_chars))); + if (EQ (charset_list, Qiso_2022)) + { + if (! EQ (coding_type, Qiso_2022)) + error ("Invalid charset-list"); + charset_list = Viso_2022_charset_list; + } + else if (EQ (charset_list, Qemacs_mule)) + { + if (! EQ (coding_type, Qemacs_mule)) + error ("Invalid charset-list"); + charset_list = Vemacs_mule_charset_list; + } + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + if (max_charset_id < XFASTINT (XCAR (tail))) + max_charset_id = XFASTINT (XCAR (tail)); + } + else + { + charset_list = Fcopy_sequence (charset_list); + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + { + struct charset *charset; + + val = XCAR (tail); + CHECK_CHARSET_GET_CHARSET (val, charset); + if (EQ (coding_type, Qiso_2022) + ? CHARSET_ISO_FINAL (charset) < 0 + : EQ (coding_type, Qemacs_mule) + ? CHARSET_EMACS_MULE_ID (charset) < 0 + : 0) + error ("Can't handle charset `%s'", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + + XSETCAR (tail, make_number (charset->id)); + if (max_charset_id < charset->id) + max_charset_id = charset->id; + } } + CODING_ATTR_CHARSET_LIST (attrs) = charset_list; + + safe_charsets = Fmake_string (make_number (max_charset_id + 1), + make_number (255)); + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + SSET (safe_charsets, XFASTINT (XCAR (tail)), 0); + CODING_ATTR_SAFE_CHARSETS (attrs) = safe_charsets; + + CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p]; + + val = args[coding_arg_decode_translation_table]; + if (! CHAR_TABLE_P (val) && ! CONSP (val)) + CHECK_SYMBOL (val); + CODING_ATTR_DECODE_TBL (attrs) = val; + + val = args[coding_arg_encode_translation_table]; + if (! CHAR_TABLE_P (val) && ! CONSP (val)) + CHECK_SYMBOL (val); + CODING_ATTR_ENCODE_TBL (attrs) = val; + + val = args[coding_arg_post_read_conversion]; + CHECK_SYMBOL (val); + CODING_ATTR_POST_READ (attrs) = val; + + val = args[coding_arg_pre_write_conversion]; + CHECK_SYMBOL (val); + CODING_ATTR_PRE_WRITE (attrs) = val; + + val = args[coding_arg_default_char]; + if (NILP (val)) + CODING_ATTR_DEFAULT_CHAR (attrs) = make_number (' '); else { - slot = Fassq (coding_system, XCDR (Vcoding_system_safe_chars)); - if (NILP (slot)) - XSETCDR (Vcoding_system_safe_chars, - nconc2 (XCDR (Vcoding_system_safe_chars), - Fcons (Fcons (coding_system, safe_chars), Qnil))); + CHECK_CHARACTER (val); + CODING_ATTR_DEFAULT_CHAR (attrs) = val; + } + + val = args[coding_arg_for_unibyte]; + CODING_ATTR_FOR_UNIBYTE (attrs) = NILP (val) ? Qnil : Qt; + + val = args[coding_arg_plist]; + CHECK_LIST (val); + CODING_ATTR_PLIST (attrs) = val; + + if (EQ (coding_type, Qcharset)) + { + /* Generate a lisp vector of 256 elements. Each element is nil, + integer, or a list of charset IDs. + + If Nth element is nil, the byte code N is invalid in this + coding system. + + If Nth element is a number NUM, N is the first byte of a + charset whose ID is NUM. + + If Nth element is a list of charset IDs, N is the first byte + of one of them. The list is sorted by dimensions of the + charsets. A charset of smaller dimension comes firtst. */ + val = Fmake_vector (make_number (256), Qnil); + + for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) + { + struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail))); + int dim = CHARSET_DIMENSION (charset); + int idx = (dim - 1) * 4; + + if (CHARSET_ASCII_COMPATIBLE_P (charset)) + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + + for (i = charset->code_space[idx]; + i <= charset->code_space[idx + 1]; i++) + { + Lisp_Object tmp, tmp2; + int dim2; + + tmp = AREF (val, i); + if (NILP (tmp)) + tmp = XCAR (tail); + else if (NUMBERP (tmp)) + { + dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp))); + if (dim < dim2) + tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil)); + else + tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil)); + } + else + { + for (tmp2 = tmp; CONSP (tmp2); tmp2 = XCDR (tmp2)) + { + dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2)))); + if (dim < dim2) + break; + } + if (NILP (tmp2)) + tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil)); + else + { + XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2))); + XSETCAR (tmp2, XCAR (tail)); + } + } + ASET (val, i, tmp); + } + } + ASET (attrs, coding_attr_charset_valids, val); + category = coding_category_charset; + } + else if (EQ (coding_type, Qccl)) + { + Lisp_Object valids; + + if (nargs < coding_arg_ccl_max) + goto short_args; + + val = args[coding_arg_ccl_decoder]; + CHECK_CCL_PROGRAM (val); + if (VECTORP (val)) + val = Fcopy_sequence (val); + ASET (attrs, coding_attr_ccl_decoder, val); + + val = args[coding_arg_ccl_encoder]; + CHECK_CCL_PROGRAM (val); + if (VECTORP (val)) + val = Fcopy_sequence (val); + ASET (attrs, coding_attr_ccl_encoder, val); + + val = args[coding_arg_ccl_valids]; + valids = Fmake_string (make_number (256), make_number (0)); + for (tail = val; !NILP (tail); tail = Fcdr (tail)) + { + int from, to; + + val = Fcar (tail); + if (INTEGERP (val)) + { + from = to = XINT (val); + if (from < 0 || from > 255) + args_out_of_range_3 (val, make_number (0), make_number (255)); + } + else + { + CHECK_CONS (val); + CHECK_NATNUM_CAR (val); + CHECK_NATNUM_CDR (val); + from = XINT (XCAR (val)); + if (from > 255) + args_out_of_range_3 (XCAR (val), + make_number (0), make_number (255)); + to = XINT (XCDR (val)); + if (to < from || to > 255) + args_out_of_range_3 (XCDR (val), + XCAR (val), make_number (255)); + } + for (i = from; i <= to; i++) + SSET (valids, i, 1); + } + ASET (attrs, coding_attr_ccl_valids, valids); + + category = coding_category_ccl; + } + else if (EQ (coding_type, Qutf_16)) + { + Lisp_Object bom, endian; + + CODING_ATTR_ASCII_COMPAT (attrs) = Qnil; + + if (nargs < coding_arg_utf16_max) + goto short_args; + + bom = args[coding_arg_utf16_bom]; + if (! NILP (bom) && ! EQ (bom, Qt)) + { + CHECK_CONS (bom); + val = XCAR (bom); + CHECK_CODING_SYSTEM (val); + val = XCDR (bom); + CHECK_CODING_SYSTEM (val); + } + ASET (attrs, coding_attr_utf_16_bom, bom); + + endian = args[coding_arg_utf16_endian]; + CHECK_SYMBOL (endian); + if (NILP (endian)) + endian = Qbig; + else if (! EQ (endian, Qbig) && ! EQ (endian, Qlittle)) + error ("Invalid endian: %s", SDATA (SYMBOL_NAME (endian))); + ASET (attrs, coding_attr_utf_16_endian, endian); + + category = (CONSP (bom) + ? coding_category_utf_16_auto + : NILP (bom) + ? (EQ (endian, Qbig) + ? coding_category_utf_16_be_nosig + : coding_category_utf_16_le_nosig) + : (EQ (endian, Qbig) + ? coding_category_utf_16_be + : coding_category_utf_16_le)); + } + else if (EQ (coding_type, Qiso_2022)) + { + Lisp_Object initial, reg_usage, request, flags; + int i; + + if (nargs < coding_arg_iso2022_max) + goto short_args; + + initial = Fcopy_sequence (args[coding_arg_iso2022_initial]); + CHECK_VECTOR (initial); + for (i = 0; i < 4; i++) + { + val = Faref (initial, make_number (i)); + if (! NILP (val)) + { + struct charset *charset; + + CHECK_CHARSET_GET_CHARSET (val, charset); + ASET (initial, i, make_number (CHARSET_ID (charset))); + if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset)) + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + } + else + ASET (initial, i, make_number (-1)); + } + + reg_usage = args[coding_arg_iso2022_reg_usage]; + CHECK_CONS (reg_usage); + CHECK_NUMBER_CAR (reg_usage); + CHECK_NUMBER_CDR (reg_usage); + + request = Fcopy_sequence (args[coding_arg_iso2022_request]); + for (tail = request; ! NILP (tail); tail = Fcdr (tail)) + { + int id; + Lisp_Object tmp; + + val = Fcar (tail); + CHECK_CONS (val); + tmp = XCAR (val); + CHECK_CHARSET_GET_ID (tmp, id); + CHECK_NATNUM_CDR (val); + if (XINT (XCDR (val)) >= 4) + error ("Invalid graphic register number: %d", XINT (XCDR (val))); + XSETCAR (val, make_number (id)); + } + + flags = args[coding_arg_iso2022_flags]; + CHECK_NATNUM (flags); + i = XINT (flags); + if (EQ (args[coding_arg_charset_list], Qiso_2022)) + flags = make_number (i | CODING_ISO_FLAG_FULL_SUPPORT); + + ASET (attrs, coding_attr_iso_initial, initial); + ASET (attrs, coding_attr_iso_usage, reg_usage); + ASET (attrs, coding_attr_iso_request, request); + ASET (attrs, coding_attr_iso_flags, flags); + setup_iso_safe_charsets (attrs); + + if (i & CODING_ISO_FLAG_SEVEN_BITS) + category = ((i & (CODING_ISO_FLAG_LOCKING_SHIFT + | CODING_ISO_FLAG_SINGLE_SHIFT)) + ? coding_category_iso_7_else + : EQ (args[coding_arg_charset_list], Qiso_2022) + ? coding_category_iso_7 + : coding_category_iso_7_tight); else - XSETCDR (slot, safe_chars); + { + int id = XINT (AREF (initial, 1)); + + category = (((i & CODING_ISO_FLAG_LOCKING_SHIFT) + || EQ (args[coding_arg_charset_list], Qiso_2022) + || id < 0) + ? coding_category_iso_8_else + : (CHARSET_DIMENSION (CHARSET_FROM_ID (id)) == 1) + ? coding_category_iso_8_1 + : coding_category_iso_8_2); + } + if (category != coding_category_iso_8_1 + && category != coding_category_iso_8_2) + CODING_ATTR_ASCII_COMPAT (attrs) = Qnil; + } + else if (EQ (coding_type, Qemacs_mule)) + { + if (EQ (args[coding_arg_charset_list], Qemacs_mule)) + ASET (attrs, coding_attr_emacs_mule_full, Qt); + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + category = coding_category_emacs_mule; + } + else if (EQ (coding_type, Qshift_jis)) + { + + struct charset *charset; + + if (XINT (Flength (charset_list)) != 3 + && XINT (Flength (charset_list)) != 4) + error ("There should be three or four charsets"); + + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 1) + error ("Dimension of charset %s is not one", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + if (CHARSET_ASCII_COMPATIBLE_P (charset)) + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + + charset_list = XCDR (charset_list); + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 1) + error ("Dimension of charset %s is not one", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + + charset_list = XCDR (charset_list); + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 2) + error ("Dimension of charset %s is not two", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + + charset_list = XCDR (charset_list); + if (! NILP (charset_list)) + { + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 2) + error ("Dimension of charset %s is not two", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + } + + category = coding_category_sjis; + Vsjis_coding_system = name; } + else if (EQ (coding_type, Qbig5)) + { + struct charset *charset; + + if (XINT (Flength (charset_list)) != 2) + error ("There should be just two charsets"); + + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 1) + error ("Dimension of charset %s is not one", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + if (CHARSET_ASCII_COMPATIBLE_P (charset)) + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + + charset_list = XCDR (charset_list); + charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); + if (CHARSET_DIMENSION (charset) != 2) + error ("Dimension of charset %s is not two", + SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); + + category = coding_category_big5; + Vbig5_coding_system = name; + } + else if (EQ (coding_type, Qraw_text)) + { + category = coding_category_raw_text; + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + } + else if (EQ (coding_type, Qutf_8)) + { + category = coding_category_utf_8; + CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + } + else if (EQ (coding_type, Qundecided)) + category = coding_category_undecided; + else + error ("Invalid coding system type: %s", + SDATA (SYMBOL_NAME (coding_type))); + + CODING_ATTR_CATEGORY (attrs) = make_number (category); + CODING_ATTR_PLIST (attrs) + = Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category), + CODING_ATTR_PLIST (attrs))); + CODING_ATTR_PLIST (attrs) + = Fcons (QCascii_compatible_p, + Fcons (CODING_ATTR_ASCII_COMPAT (attrs), + CODING_ATTR_PLIST (attrs))); + + eol_type = args[coding_arg_eol_type]; + if (! NILP (eol_type) + && ! EQ (eol_type, Qunix) + && ! EQ (eol_type, Qdos) + && ! EQ (eol_type, Qmac)) + error ("Invalid eol-type"); + + aliases = Fcons (name, Qnil); + + if (NILP (eol_type)) + { + eol_type = make_subsidiaries (name); + for (i = 0; i < 3; i++) + { + Lisp_Object this_spec, this_name, this_aliases, this_eol_type; + + this_name = AREF (eol_type, i); + this_aliases = Fcons (this_name, Qnil); + this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac); + this_spec = Fmake_vector (make_number (3), attrs); + ASET (this_spec, 1, this_aliases); + ASET (this_spec, 2, this_eol_type); + Fputhash (this_name, this_spec, Vcoding_system_hash_table); + Vcoding_system_list = Fcons (this_name, Vcoding_system_list); + val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist); + if (NILP (val)) + Vcoding_system_alist + = Fcons (Fcons (Fsymbol_name (this_name), Qnil), + Vcoding_system_alist); + } + } + + spec_vec = Fmake_vector (make_number (3), attrs); + ASET (spec_vec, 1, aliases); + ASET (spec_vec, 2, eol_type); + + Fputhash (name, spec_vec, Vcoding_system_hash_table); + Vcoding_system_list = Fcons (name, Vcoding_system_list); + val = Fassoc (Fsymbol_name (name), Vcoding_system_alist); + if (NILP (val)) + Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil), + Vcoding_system_alist); + + { + int id = coding_categories[category].id; + + if (id < 0 || EQ (name, CODING_ID_NAME (id))) + setup_coding_system (name, &coding_categories[category]); + } + return Qnil; + + short_args: + return Fsignal (Qwrong_number_of_arguments, + Fcons (intern ("define-coding-system-internal"), + make_number (nargs))); +} + + +DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put, + 3, 3, 0, + doc: /* Change value in CODING-SYSTEM's property list PROP to VAL. */) + (coding_system, prop, val) + Lisp_Object coding_system, prop, val; +{ + Lisp_Object spec, attrs; + + CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec); + attrs = AREF (spec, 0); + if (EQ (prop, QCmnemonic)) + { + if (! STRINGP (val)) + CHECK_CHARACTER (val); + CODING_ATTR_MNEMONIC (attrs) = val; + } + else if (EQ (prop, QCdefalut_char)) + { + if (NILP (val)) + val = make_number (' '); + else + CHECK_CHARACTER (val); + CODING_ATTR_DEFAULT_CHAR (attrs) = val; + } + else if (EQ (prop, QCdecode_translation_table)) + { + if (! CHAR_TABLE_P (val) && ! CONSP (val)) + CHECK_SYMBOL (val); + CODING_ATTR_DECODE_TBL (attrs) = val; + } + else if (EQ (prop, QCencode_translation_table)) + { + if (! CHAR_TABLE_P (val) && ! CONSP (val)) + CHECK_SYMBOL (val); + CODING_ATTR_ENCODE_TBL (attrs) = val; + } + else if (EQ (prop, QCpost_read_conversion)) + { + CHECK_SYMBOL (val); + CODING_ATTR_POST_READ (attrs) = val; + } + else if (EQ (prop, QCpre_write_conversion)) + { + CHECK_SYMBOL (val); + CODING_ATTR_PRE_WRITE (attrs) = val; + } + else if (EQ (prop, QCascii_compatible_p)) + { + CODING_ATTR_ASCII_COMPAT (attrs) = val; + } + + CODING_ATTR_PLIST (attrs) + = Fplist_put (CODING_ATTR_PLIST (attrs), prop, val); + return val; +} + + +DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, + Sdefine_coding_system_alias, 2, 2, 0, + doc: /* Define ALIAS as an alias for CODING-SYSTEM. */) + (alias, coding_system) + Lisp_Object alias, coding_system; +{ + Lisp_Object spec, aliases, eol_type, val; + + CHECK_SYMBOL (alias); + CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec); + aliases = AREF (spec, 1); + /* ALISES should be a list of length more than zero, and the first + element is a base coding system. Append ALIAS at the tail of the + list. */ + while (!NILP (XCDR (aliases))) + aliases = XCDR (aliases); + XSETCDR (aliases, Fcons (alias, Qnil)); + + eol_type = AREF (spec, 2); + if (VECTORP (eol_type)) + { + Lisp_Object subsidiaries; + int i; + + subsidiaries = make_subsidiaries (alias); + for (i = 0; i < 3; i++) + Fdefine_coding_system_alias (AREF (subsidiaries, i), + AREF (eol_type, i)); + } + + Fputhash (alias, spec, Vcoding_system_hash_table); + Vcoding_system_list = Fcons (alias, Vcoding_system_list); + val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist); + if (NILP (val)) + Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil), + Vcoding_system_alist); + + return Qnil; +} + +DEFUN ("coding-system-base", Fcoding_system_base, Scoding_system_base, + 1, 1, 0, + doc: /* Return the base of CODING-SYSTEM. +Any alias or subsidiary coding system is not a base coding system. */) + (coding_system) + Lisp_Object coding_system; +{ + Lisp_Object spec, attrs; + + if (NILP (coding_system)) + return (Qno_conversion); + CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec); + attrs = AREF (spec, 0); + return CODING_ATTR_BASE_NAME (attrs); +} + +DEFUN ("coding-system-plist", Fcoding_system_plist, Scoding_system_plist, + 1, 1, 0, + doc: "Return the property list of CODING-SYSTEM.") + (coding_system) + Lisp_Object coding_system; +{ + Lisp_Object spec, attrs; + + if (NILP (coding_system)) + coding_system = Qno_conversion; + CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec); + attrs = AREF (spec, 0); + return CODING_ATTR_PLIST (attrs); +} + + +DEFUN ("coding-system-aliases", Fcoding_system_aliases, Scoding_system_aliases, + 1, 1, 0, + doc: /* Return the list of aliases of CODING-SYSTEM. */) + (coding_system) + Lisp_Object coding_system; +{ + Lisp_Object spec; + + if (NILP (coding_system)) + coding_system = Qno_conversion; + CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec); + return AREF (spec, 1); +} + +DEFUN ("coding-system-eol-type", Fcoding_system_eol_type, + Scoding_system_eol_type, 1, 1, 0, + doc: /* Return eol-type of CODING-SYSTEM. +An eol-type is integer 0, 1, 2, or a vector of coding systems. + +Integer values 0, 1, and 2 indicate a format of end-of-line; LF, CRLF, +and CR respectively. + +A vector value indicates that a format of end-of-line should be +detected automatically. Nth element of the vector is the subsidiary +coding system whose eol-type is N. */) + (coding_system) + Lisp_Object coding_system; +{ + Lisp_Object spec, eol_type; + int n; + + if (NILP (coding_system)) + coding_system = Qno_conversion; + if (! CODING_SYSTEM_P (coding_system)) + return Qnil; + spec = CODING_SYSTEM_SPEC (coding_system); + eol_type = AREF (spec, 2); + if (VECTORP (eol_type)) + return Fcopy_sequence (eol_type); + n = EQ (eol_type, Qunix) ? 0 : EQ (eol_type, Qdos) ? 1 : 2; + return make_number (n); } #endif /* emacs */ @@ -7676,20 +9287,11 @@ init_coding_once () { int i; - /* Emacs' internal format specific initialize routine. */ - for (i = 0; i <= 0x20; i++) - emacs_code_class[i] = EMACS_control_code; - emacs_code_class[0x0A] = EMACS_linefeed_code; - emacs_code_class[0x0D] = EMACS_carriage_return_code; - for (i = 0x21 ; i < 0x7F; i++) - emacs_code_class[i] = EMACS_ascii_code; - emacs_code_class[0x7F] = EMACS_control_code; - for (i = 0x80; i < 0xFF; i++) - emacs_code_class[i] = EMACS_invalid_code; - emacs_code_class[LEADING_CODE_PRIVATE_11] = EMACS_leading_code_3; - emacs_code_class[LEADING_CODE_PRIVATE_12] = EMACS_leading_code_3; - emacs_code_class[LEADING_CODE_PRIVATE_21] = EMACS_leading_code_4; - emacs_code_class[LEADING_CODE_PRIVATE_22] = EMACS_leading_code_4; + for (i = 0; i < coding_category_max; i++) + { + coding_categories[i].id = -1; + coding_priorities[i] = i; + } /* ISO2022 specific initialize routine. */ for (i = 0; i < 0x20; i++) @@ -7702,7 +9304,6 @@ init_coding_once () iso_code_class[i] = ISO_graphic_plane_1; iso_code_class[0x20] = iso_code_class[0x7F] = ISO_0x20_or_0x7F; iso_code_class[0xA0] = iso_code_class[0xFF] = ISO_0xA0_or_0xFF; - iso_code_class[ISO_CODE_CR] = ISO_carriage_return; iso_code_class[ISO_CODE_SO] = ISO_shift_out; iso_code_class[ISO_CODE_SI] = ISO_shift_in; iso_code_class[ISO_CODE_SS2_7] = ISO_single_shift_2_7; @@ -7711,22 +9312,14 @@ init_coding_once () iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3; iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer; - setup_coding_system (Qnil, &safe_terminal_coding); - setup_coding_system (Qnil, &default_buffer_file_coding); - - bzero (coding_system_table, sizeof coding_system_table); - - bzero (ascii_skip_code, sizeof ascii_skip_code); - for (i = 0; i < 128; i++) - ascii_skip_code[i] = 1; - -#if defined (MSDOS) || defined (WINDOWSNT) - system_eol_type = CODING_EOL_CRLF; -#else - system_eol_type = CODING_EOL_LF; -#endif - - inhibit_pre_post_conversion = 0; + for (i = 0; i < 256; i++) + { + emacs_mule_bytes[i] = 1; + } + emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_11] = 3; + emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_12] = 3; + emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_21] = 4; + emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_22] = 4; } #ifdef emacs @@ -7734,14 +9327,31 @@ init_coding_once () void syms_of_coding () { + staticpro (&Vcoding_system_hash_table); + { + Lisp_Object args[2]; + args[0] = QCtest; + args[1] = Qeq; + Vcoding_system_hash_table = Fmake_hash_table (2, args); + } + + staticpro (&Vsjis_coding_system); + Vsjis_coding_system = Qnil; + + staticpro (&Vbig5_coding_system); + Vbig5_coding_system = Qnil; + + staticpro (&Vcode_conversion_reused_workbuf); + Vcode_conversion_reused_workbuf = Qnil; + staticpro (&Vcode_conversion_workbuf_name); Vcode_conversion_workbuf_name = build_string (" *code-conversion-work*"); - Qtarget_idx = intern ("target-idx"); - staticpro (&Qtarget_idx); + reused_workbuf_in_use = 0; - Qcoding_system_history = intern ("coding-system-history"); - staticpro (&Qcoding_system_history); + DEFSYM (Qcharset, "charset"); + DEFSYM (Qtarget_idx, "target-idx"); + DEFSYM (Qcoding_system_history, "coding-system-history"); Fset (Qcoding_system_history, Qnil); /* Target FILENAME is the first argument. */ @@ -7749,123 +9359,131 @@ syms_of_coding () /* Target FILENAME is the third argument. */ Fput (Qwrite_region, Qtarget_idx, make_number (2)); - Qcall_process = intern ("call-process"); - staticpro (&Qcall_process); + DEFSYM (Qcall_process, "call-process"); /* Target PROGRAM is the first argument. */ Fput (Qcall_process, Qtarget_idx, make_number (0)); - Qcall_process_region = intern ("call-process-region"); - staticpro (&Qcall_process_region); + DEFSYM (Qcall_process_region, "call-process-region"); /* Target PROGRAM is the third argument. */ Fput (Qcall_process_region, Qtarget_idx, make_number (2)); - Qstart_process = intern ("start-process"); - staticpro (&Qstart_process); + DEFSYM (Qstart_process, "start-process"); /* Target PROGRAM is the third argument. */ Fput (Qstart_process, Qtarget_idx, make_number (2)); - Qopen_network_stream = intern ("open-network-stream"); - staticpro (&Qopen_network_stream); + DEFSYM (Qopen_network_stream, "open-network-stream"); /* Target SERVICE is the fourth argument. */ Fput (Qopen_network_stream, Qtarget_idx, make_number (3)); - Qcoding_system = intern ("coding-system"); - staticpro (&Qcoding_system); - - Qeol_type = intern ("eol-type"); - staticpro (&Qeol_type); + DEFSYM (Qcoding_system, "coding-system"); + DEFSYM (Qcoding_aliases, "coding-aliases"); - Qbuffer_file_coding_system = intern ("buffer-file-coding-system"); - staticpro (&Qbuffer_file_coding_system); + DEFSYM (Qeol_type, "eol-type"); + DEFSYM (Qunix, "unix"); + DEFSYM (Qdos, "dos"); - Qpost_read_conversion = intern ("post-read-conversion"); - staticpro (&Qpost_read_conversion); + DEFSYM (Qbuffer_file_coding_system, "buffer-file-coding-system"); + DEFSYM (Qpost_read_conversion, "post-read-conversion"); + DEFSYM (Qpre_write_conversion, "pre-write-conversion"); + DEFSYM (Qdefault_char, "default-char"); + DEFSYM (Qundecided, "undecided"); + DEFSYM (Qno_conversion, "no-conversion"); + DEFSYM (Qraw_text, "raw-text"); - Qpre_write_conversion = intern ("pre-write-conversion"); - staticpro (&Qpre_write_conversion); + DEFSYM (Qiso_2022, "iso-2022"); - Qno_conversion = intern ("no-conversion"); - staticpro (&Qno_conversion); + DEFSYM (Qutf_8, "utf-8"); + DEFSYM (Qutf_8_emacs, "utf-8-emacs"); - Qundecided = intern ("undecided"); - staticpro (&Qundecided); + DEFSYM (Qutf_16, "utf-16"); + DEFSYM (Qbig, "big"); + DEFSYM (Qlittle, "little"); - Qcoding_system_p = intern ("coding-system-p"); - staticpro (&Qcoding_system_p); + DEFSYM (Qshift_jis, "shift-jis"); + DEFSYM (Qbig5, "big5"); - Qcoding_system_error = intern ("coding-system-error"); - staticpro (&Qcoding_system_error); + DEFSYM (Qcoding_system_p, "coding-system-p"); + DEFSYM (Qcoding_system_error, "coding-system-error"); Fput (Qcoding_system_error, Qerror_conditions, Fcons (Qcoding_system_error, Fcons (Qerror, Qnil))); Fput (Qcoding_system_error, Qerror_message, build_string ("Invalid coding system")); - Qcoding_category = intern ("coding-category"); - staticpro (&Qcoding_category); - Qcoding_category_index = intern ("coding-category-index"); - staticpro (&Qcoding_category_index); - - Vcoding_category_table - = Fmake_vector (make_number (CODING_CATEGORY_IDX_MAX), Qnil); - staticpro (&Vcoding_category_table); - { - int i; - for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++) - { - XVECTOR (Vcoding_category_table)->contents[i] - = intern (coding_category_name[i]); - Fput (XVECTOR (Vcoding_category_table)->contents[i], - Qcoding_category_index, make_number (i)); - } - } - - Vcoding_system_safe_chars = Fcons (Qnil, Qnil); - staticpro (&Vcoding_system_safe_chars); - - Qtranslation_table = intern ("translation-table"); - staticpro (&Qtranslation_table); - Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (2)); - - Qtranslation_table_id = intern ("translation-table-id"); - staticpro (&Qtranslation_table_id); - - Qtranslation_table_for_decode = intern ("translation-table-for-decode"); - staticpro (&Qtranslation_table_for_decode); - - Qtranslation_table_for_encode = intern ("translation-table-for-encode"); - staticpro (&Qtranslation_table_for_encode); - - Qsafe_chars = intern ("safe-chars"); - staticpro (&Qsafe_chars); - - Qchar_coding_system = intern ("char-coding-system"); - staticpro (&Qchar_coding_system); - /* Intern this now in case it isn't already done. Setting this variable twice is harmless. But don't staticpro it here--that is done in alloc.c. */ Qchar_table_extra_slots = intern ("char-table-extra-slots"); - Fput (Qsafe_chars, Qchar_table_extra_slots, make_number (0)); - Fput (Qchar_coding_system, Qchar_table_extra_slots, make_number (0)); - - Qvalid_codes = intern ("valid-codes"); - staticpro (&Qvalid_codes); - Qascii_incompatible = intern ("ascii-incompatible"); - staticpro (&Qascii_incompatible); + DEFSYM (Qtranslation_table, "translation-table"); + Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (2)); + DEFSYM (Qtranslation_table_id, "translation-table-id"); + DEFSYM (Qtranslation_table_for_decode, "translation-table-for-decode"); + DEFSYM (Qtranslation_table_for_encode, "translation-table-for-encode"); - Qemacs_mule = intern ("emacs-mule"); - staticpro (&Qemacs_mule); + DEFSYM (Qvalid_codes, "valid-codes"); - Qraw_text = intern ("raw-text"); - staticpro (&Qraw_text); + DEFSYM (Qemacs_mule, "emacs-mule"); - Qutf_8 = intern ("utf-8"); - staticpro (&Qutf_8); + DEFSYM (QCcategory, ":category"); + DEFSYM (QCmnemonic, ":mnemonic"); + DEFSYM (QCdefalut_char, ":default-char"); + DEFSYM (QCdecode_translation_table, ":decode-translation-table"); + DEFSYM (QCencode_translation_table, ":encode-translation-table"); + DEFSYM (QCpost_read_conversion, ":post-read-conversion"); + DEFSYM (QCpre_write_conversion, ":pre-write-conversion"); + DEFSYM (QCascii_compatible_p, ":ascii-compatible-p"); - Qcoding_system_define_form = intern ("coding-system-define-form"); - staticpro (&Qcoding_system_define_form); + Vcoding_category_table + = Fmake_vector (make_number (coding_category_max), Qnil); + staticpro (&Vcoding_category_table); + /* Followings are target of code detection. */ + ASET (Vcoding_category_table, coding_category_iso_7, + intern ("coding-category-iso-7")); + ASET (Vcoding_category_table, coding_category_iso_7_tight, + intern ("coding-category-iso-7-tight")); + ASET (Vcoding_category_table, coding_category_iso_8_1, + intern ("coding-category-iso-8-1")); + ASET (Vcoding_category_table, coding_category_iso_8_2, + intern ("coding-category-iso-8-2")); + ASET (Vcoding_category_table, coding_category_iso_7_else, + intern ("coding-category-iso-7-else")); + ASET (Vcoding_category_table, coding_category_iso_8_else, + intern ("coding-category-iso-8-else")); + ASET (Vcoding_category_table, coding_category_utf_8, + intern ("coding-category-utf-8")); + ASET (Vcoding_category_table, coding_category_utf_16_be, + intern ("coding-category-utf-16-be")); + ASET (Vcoding_category_table, coding_category_utf_16_auto, + intern ("coding-category-utf-16-auto")); + ASET (Vcoding_category_table, coding_category_utf_16_le, + intern ("coding-category-utf-16-le")); + ASET (Vcoding_category_table, coding_category_utf_16_be_nosig, + intern ("coding-category-utf-16-be-nosig")); + ASET (Vcoding_category_table, coding_category_utf_16_le_nosig, + intern ("coding-category-utf-16-le-nosig")); + ASET (Vcoding_category_table, coding_category_charset, + intern ("coding-category-charset")); + ASET (Vcoding_category_table, coding_category_sjis, + intern ("coding-category-sjis")); + ASET (Vcoding_category_table, coding_category_big5, + intern ("coding-category-big5")); + ASET (Vcoding_category_table, coding_category_ccl, + intern ("coding-category-ccl")); + ASET (Vcoding_category_table, coding_category_emacs_mule, + intern ("coding-category-emacs-mule")); + /* Followings are NOT target of code detection. */ + ASET (Vcoding_category_table, coding_category_raw_text, + intern ("coding-category-raw-text")); + ASET (Vcoding_category_table, coding_category_undecided, + intern ("coding-category-undecided")); + + DEFSYM (Qinsufficient_source, "insufficient-source"); + DEFSYM (Qinconsistent_eol, "inconsistent-eol"); + DEFSYM (Qinvalid_source, "invalid-source"); + DEFSYM (Qinterrupted, "interrupted"); + DEFSYM (Qinsufficient_memory, "insufficient-memory"); + DEFSYM (Qcoding_system_define_form, "coding-system-define-form"); defsubr (&Scoding_system_p); defsubr (&Sread_coding_system); @@ -7875,6 +9493,7 @@ syms_of_coding () defsubr (&Sdetect_coding_string); defsubr (&Sfind_coding_systems_region_internal); defsubr (&Sunencodable_char_position); + defsubr (&Scheck_coding_systems_region); defsubr (&Sdecode_coding_region); defsubr (&Sencode_coding_region); defsubr (&Sdecode_coding_string); @@ -7889,15 +9508,21 @@ syms_of_coding () defsubr (&Sset_keyboard_coding_system_internal); defsubr (&Skeyboard_coding_system); defsubr (&Sfind_operation_coding_system); - defsubr (&Supdate_coding_systems_internal); - defsubr (&Sset_coding_priority_internal); + defsubr (&Sset_coding_system_priority); defsubr (&Sdefine_coding_system_internal); + defsubr (&Sdefine_coding_system_alias); + defsubr (&Scoding_system_put); + defsubr (&Scoding_system_base); + defsubr (&Scoding_system_plist); + defsubr (&Scoding_system_aliases); + defsubr (&Scoding_system_eol_type); + defsubr (&Scoding_system_priority_list); DEFVAR_LISP ("coding-system-list", &Vcoding_system_list, doc: /* List of coding systems. Do not alter the value of this variable manually. This variable should be -updated by the functions `make-coding-system' and +updated by the functions `define-coding-system' and `define-coding-system-alias'. */); Vcoding_system_list = Qnil; @@ -7924,7 +9549,7 @@ Don't modify this variable directly, but use `set-coding-priority'. */); int i; Vcoding_category_list = Qnil; - for (i = CODING_CATEGORY_IDX_MAX - 1; i >= 0; i--) + for (i = coding_category_max - 1; i >= 0; i--) Vcoding_category_list = Fcons (XVECTOR (Vcoding_category_table)->contents[i], Vcoding_category_list); @@ -7954,25 +9579,44 @@ the value of `buffer-file-coding-system' is used. */); Vcoding_system_for_write = Qnil; DEFVAR_LISP ("last-coding-system-used", &Vlast_coding_system_used, - doc: /* Coding system used in the latest file or process I/O. -Also set by `encode-coding-region', `decode-coding-region', -`encode-coding-string' and `decode-coding-string'. */); + doc: /* +Coding system used in the latest file or process I/O. */); Vlast_coding_system_used = Qnil; + DEFVAR_LISP ("last-code-conversion-error", &Vlast_code_conversion_error, + doc: /* +Error status of the last code conversion. + +When an error was detected in the last code conversion, this variable +is set to one of the following symbols. + `insufficient-source' + `inconsistent-eol' + `invalid-source' + `interrupted' + `insufficient-memory' +When no error was detected, the value doesn't change. So, to check +the error status of a code conversion by this variable, you must +explicitly set this variable to nil before performing code +conversion. */); + Vlast_code_conversion_error = Qnil; + DEFVAR_BOOL ("inhibit-eol-conversion", &inhibit_eol_conversion, - doc: /* *Non-nil means always inhibit code conversion of end-of-line format. + doc: /* +*Non-nil means always inhibit code conversion of end-of-line format. See info node `Coding Systems' and info node `Text and Binary' concerning such conversion. */); inhibit_eol_conversion = 0; DEFVAR_BOOL ("inherit-process-coding-system", &inherit_process_coding_system, - doc: /* Non-nil means process buffer inherits coding system of process output. + doc: /* +Non-nil means process buffer inherits coding system of process output. Bind it to t if the process output is to be treated as if it were a file read from some filesystem. */); inherit_process_coding_system = 0; DEFVAR_LISP ("file-coding-system-alist", &Vfile_coding_system_alist, - doc: /* Alist to decide a coding system to use for a file I/O operation. + doc: /* +Alist to decide a coding system to use for a file I/O operation. The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression matching a file name, VAL is a coding system, a cons of coding systems, or a function symbol. @@ -7992,7 +9636,8 @@ and the variable `auto-coding-alist'. */); Vfile_coding_system_alist = Qnil; DEFVAR_LISP ("process-coding-system-alist", &Vprocess_coding_system_alist, - doc: /* Alist to decide a coding system to use for a process I/O operation. + doc: /* +Alist to decide a coding system to use for a process I/O operation. The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression matching a program name, VAL is a coding system, a cons of coding systems, or a function symbol. @@ -8007,7 +9652,8 @@ See also the function `find-operation-coding-system'. */); Vprocess_coding_system_alist = Qnil; DEFVAR_LISP ("network-coding-system-alist", &Vnetwork_coding_system_alist, - doc: /* Alist to decide a coding system to use for a network I/O operation. + doc: /* +Alist to decide a coding system to use for a network I/O operation. The format is ((PATTERN . VAL) ...), where PATTERN is a regular expression matching a network service name or is a port number to connect to, @@ -8029,23 +9675,28 @@ Also used for decoding keyboard input on X Window system. */); /* The eol mnemonics are reset in startup.el system-dependently. */ DEFVAR_LISP ("eol-mnemonic-unix", &eol_mnemonic_unix, - doc: /* *String displayed in mode line for UNIX-like (LF) end-of-line format. */); + doc: /* +*String displayed in mode line for UNIX-like (LF) end-of-line format. */); eol_mnemonic_unix = build_string (":"); DEFVAR_LISP ("eol-mnemonic-dos", &eol_mnemonic_dos, - doc: /* *String displayed in mode line for DOS-like (CRLF) end-of-line format. */); + doc: /* +*String displayed in mode line for DOS-like (CRLF) end-of-line format. */); eol_mnemonic_dos = build_string ("\\"); DEFVAR_LISP ("eol-mnemonic-mac", &eol_mnemonic_mac, - doc: /* *String displayed in mode line for MAC-like (CR) end-of-line format. */); + doc: /* +*String displayed in mode line for MAC-like (CR) end-of-line format. */); eol_mnemonic_mac = build_string ("/"); DEFVAR_LISP ("eol-mnemonic-undecided", &eol_mnemonic_undecided, - doc: /* *String displayed in mode line when end-of-line format is not yet determined. */); + doc: /* +*String displayed in mode line when end-of-line format is not yet determined. */); eol_mnemonic_undecided = build_string (":"); DEFVAR_LISP ("enable-character-translation", &Venable_character_translation, - doc: /* *Non-nil enables character translation while encoding and decoding. */); + doc: /* +*Non-nil enables character translation while encoding and decoding. */); Venable_character_translation = Qt; DEFVAR_LISP ("standard-translation-table-for-decode", @@ -8058,11 +9709,12 @@ Also used for decoding keyboard input on X Window system. */); doc: /* Table for translating characters while encoding. */); Vstandard_translation_table_for_encode = Qnil; - DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_alist, + DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_table, doc: /* Alist of charsets vs revision numbers. While encoding, if a charset (car part of an element) is found, -designate it with the escape sequence identifying revision (cdr part of the element). */); - Vcharset_revision_alist = Qnil; +designate it with the escape sequence identifying revision (cdr part +of the element). */); + Vcharset_revision_table = Qnil; DEFVAR_LISP ("default-process-coding-system", &Vdefault_process_coding_system, @@ -8072,7 +9724,8 @@ the cdr part is used for encoding a text to be sent to a process. */); Vdefault_process_coding_system = Qnil; DEFVAR_LISP ("latin-extra-code-table", &Vlatin_extra_code_table, - doc: /* Table of extra Latin codes in the range 128..159 (inclusive). + doc: /* +Table of extra Latin codes in the range 128..159 (inclusive). This is a vector of length 256. If Nth element is non-nil, the existence of code N in a file \(or output of subprocess) doesn't prevent it to be detected as @@ -8084,7 +9737,8 @@ Only 128th through 159th elements has a meaning. */); DEFVAR_LISP ("select-safe-coding-system-function", &Vselect_safe_coding_system_function, - doc: /* Function to call to select safe coding system for encoding a text. + doc: /* +Function to call to select safe coding system for encoding a text. If set, this function is called to force a user to select a proper coding system which can encode the text in the case that a default @@ -8104,7 +9758,8 @@ called even if `coding-system-for-write' is non-nil. The command DEFVAR_BOOL ("inhibit-iso-escape-detection", &inhibit_iso_escape_detection, - doc: /* If non-nil, Emacs ignores ISO2022's escape sequence on code detection. + doc: /* +If non-nil, Emacs ignores ISO2022's escape sequence on code detection. By default, on reading a file, Emacs tries to detect how the text is encoded. This code detection is sensitive to escape sequences. If @@ -8134,6 +9789,66 @@ escape sequence (e.g `latin-1') on reading by \\[universal-coding-system-argumen This is applied to the result of input methods, not their input. See also `keyboard-translate-table'. */); Vtranslation_table_for_input = Qnil; + + { + Lisp_Object args[coding_arg_max]; + Lisp_Object plist[16]; + int i; + + for (i = 0; i < coding_arg_max; i++) + args[i] = Qnil; + + plist[0] = intern (":name"); + plist[1] = args[coding_arg_name] = Qno_conversion; + plist[2] = intern (":mnemonic"); + plist[3] = args[coding_arg_mnemonic] = make_number ('='); + plist[4] = intern (":coding-type"); + plist[5] = args[coding_arg_coding_type] = Qraw_text; + plist[6] = intern (":ascii-compatible-p"); + plist[7] = args[coding_arg_ascii_compatible_p] = Qt; + plist[8] = intern (":default-char"); + plist[9] = args[coding_arg_default_char] = make_number (0); + plist[10] = intern (":for-unibyte"); + plist[11] = args[coding_arg_for_unibyte] = Qt; + plist[12] = intern (":docstring"); + plist[13] = build_string ("Do no conversion.\n\ +\n\ +When you visit a file with this coding, the file is read into a\n\ +unibyte buffer as is, thus each byte of a file is treated as a\n\ +character."); + plist[14] = intern (":eol-type"); + plist[15] = args[coding_arg_eol_type] = Qunix; + args[coding_arg_plist] = Flist (16, plist); + Fdefine_coding_system_internal (coding_arg_max, args); + + plist[1] = args[coding_arg_name] = Qundecided; + plist[3] = args[coding_arg_mnemonic] = make_number ('-'); + plist[5] = args[coding_arg_coding_type] = Qundecided; + /* This is already set. + plist[7] = args[coding_arg_ascii_compatible_p] = Qt; */ + plist[8] = intern (":charset-list"); + plist[9] = args[coding_arg_charset_list] = Fcons (Qascii, Qnil); + plist[11] = args[coding_arg_for_unibyte] = Qnil; + plist[13] = build_string ("No conversion on encoding, automatic conversion on decoding."); + plist[15] = args[coding_arg_eol_type] = Qnil; + args[coding_arg_plist] = Flist (16, plist); + Fdefine_coding_system_internal (coding_arg_max, args); + } + + setup_coding_system (Qno_conversion, &safe_terminal_coding); + + { + int i; + + for (i = 0; i < coding_category_max; i++) + Fset (AREF (Vcoding_category_table, i), Qno_conversion); + } +#if defined (MSDOS) || defined (WINDOWSNT) + system_eol_type = Qdos; +#else + system_eol_type = Qunix; +#endif + staticpro (&system_eol_type); } char * diff --git a/src/coding.h b/src/coding.h index a53a74ec161..ef464caeadc 100644 --- a/src/coding.h +++ b/src/coding.h @@ -5,6 +5,9 @@ 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -26,306 +29,253 @@ Boston, MA 02110-1301, USA. */ #ifndef EMACS_CODING_H #define EMACS_CODING_H -#include "ccl.h" +/* Index to arguments of Fdefine_coding_system_internal. */ -/*** EMACS' INTERNAL FORMAT (emacs-mule) section ***/ +enum define_coding_system_arg_index + { + coding_arg_name, + coding_arg_mnemonic, + coding_arg_coding_type, + coding_arg_charset_list, + coding_arg_ascii_compatible_p, + coding_arg_decode_translation_table, + coding_arg_encode_translation_table, + coding_arg_post_read_conversion, + coding_arg_pre_write_conversion, + coding_arg_default_char, + coding_arg_for_unibyte, + coding_arg_plist, + coding_arg_eol_type, + coding_arg_max + }; -/* All code (1-byte) of Emacs' internal format is classified into one - of the followings. See also `charset.h'. */ -enum emacs_code_class_type +enum define_coding_iso2022_arg_index { - EMACS_control_code, /* Control codes in the range - 0x00..0x1F and 0x7F except for the - following two codes. */ - EMACS_linefeed_code, /* 0x0A (linefeed) to denote - end-of-line. */ - EMACS_carriage_return_code, /* 0x0D (carriage-return) to be used - in selective display mode. */ - EMACS_ascii_code, /* ASCII characters. */ - EMACS_leading_code_2, /* Base leading code of official - TYPE9N character. */ - EMACS_leading_code_3, /* Base leading code of private TYPE9N - or official TYPE9Nx9N character. */ - EMACS_leading_code_4, /* Base leading code of private - TYPE9Nx9N character. */ - EMACS_invalid_code /* Invalid code, i.e. a base leading - code not yet assigned to any - charset, or a code of the range - 0xA0..0xFF. */ + coding_arg_iso2022_initial = coding_arg_max, + coding_arg_iso2022_reg_usage, + coding_arg_iso2022_request, + coding_arg_iso2022_flags, + coding_arg_iso2022_max }; -extern enum emacs_code_class_type emacs_code_class[256]; - -/*** ISO2022 section ***/ - -/* Macros to define code of control characters for ISO2022's functions. */ - /* code */ /* function */ -#define ISO_CODE_LF 0x0A /* line-feed */ -#define ISO_CODE_CR 0x0D /* carriage-return */ -#define ISO_CODE_SO 0x0E /* shift-out */ -#define ISO_CODE_SI 0x0F /* shift-in */ -#define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */ -#define ISO_CODE_ESC 0x1B /* escape */ -#define ISO_CODE_SS2 0x8E /* single-shift-2 */ -#define ISO_CODE_SS3 0x8F /* single-shift-3 */ -#define ISO_CODE_CSI 0x9B /* control-sequence-introduce */ - -/* All code (1-byte) of ISO2022 is classified into one of the - followings. */ -enum iso_code_class_type +enum define_coding_utf16_arg_index { - ISO_control_0, /* Control codes in the range - 0x00..0x1F and 0x7F, except for the - following 5 codes. */ - ISO_carriage_return, /* ISO_CODE_CR (0x0D) */ - ISO_shift_out, /* ISO_CODE_SO (0x0E) */ - ISO_shift_in, /* ISO_CODE_SI (0x0F) */ - ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */ - ISO_escape, /* ISO_CODE_SO (0x1B) */ - ISO_control_1, /* Control codes in the range - 0x80..0x9F, except for the - following 3 codes. */ - ISO_single_shift_2, /* ISO_CODE_SS2 (0x8E) */ - ISO_single_shift_3, /* ISO_CODE_SS3 (0x8F) */ - ISO_control_sequence_introducer, /* ISO_CODE_CSI (0x9B) */ - ISO_0x20_or_0x7F, /* Codes of the values 0x20 or 0x7F. */ - ISO_graphic_plane_0, /* Graphic codes in the range 0x21..0x7E. */ - ISO_0xA0_or_0xFF, /* Codes of the values 0xA0 or 0xFF. */ - ISO_graphic_plane_1 /* Graphic codes in the range 0xA1..0xFE. */ + coding_arg_utf16_bom = coding_arg_max, + coding_arg_utf16_endian, + coding_arg_utf16_max }; -/** The macros CODING_FLAG_ISO_XXX defines a flag bit of the `flags' - element in the structure `coding_system'. This information is used - while encoding a text to ISO2022. **/ +enum define_coding_ccl_arg_index + { + coding_arg_ccl_decoder = coding_arg_max, + coding_arg_ccl_encoder, + coding_arg_ccl_valids, + coding_arg_ccl_max + }; -/* If set, produce short-form designation sequence (e.g. ESC $ A) - instead of long-form sequence (e.g. ESC $ ( A). */ -#define CODING_FLAG_ISO_SHORT_FORM 0x0001 +/* Hash table for all coding systems. Keys are coding system symbols + and values are spec vectors of the corresponding coding system. A + spec vector has the form [ ATTRS ALIASES EOL-TYPE ]. ATTRS is a + vector of attribute of the coding system. ALIASES is a list of + aliases (symbols) of the coding system. EOL-TYPE is `unix', `dos', + `mac' or a vector of coding systems (symbols). */ -/* If set, reset graphic planes and registers at end-of-line to the - initial state. */ -#define CODING_FLAG_ISO_RESET_AT_EOL 0x0002 +extern Lisp_Object Vcoding_system_hash_table; -/* If set, reset graphic planes and registers before any control - characters to the initial state. */ -#define CODING_FLAG_ISO_RESET_AT_CNTL 0x0004 -/* If set, encode by 7-bit environment. */ -#define CODING_FLAG_ISO_SEVEN_BITS 0x0008 +/* Enumeration of coding system type. */ -/* If set, use locking-shift function. */ -#define CODING_FLAG_ISO_LOCKING_SHIFT 0x0010 +enum coding_system_type + { + coding_type_charset, + coding_type_utf_8, + coding_type_utf_16, + coding_type_iso_2022, + coding_type_emacs_mule, + coding_type_sjis, + coding_type_ccl, + coding_type_raw_text, + coding_type_undecided, + coding_type_max + }; -/* If set, use single-shift function. Overwrite - CODING_FLAG_ISO_LOCKING_SHIFT. */ -#define CODING_FLAG_ISO_SINGLE_SHIFT 0x0020 -/* If set, designate JISX0201-Roman instead of ASCII. */ -#define CODING_FLAG_ISO_USE_ROMAN 0x0040 +/* Enumeration of end-of-line format type. */ -/* If set, designate JISX0208-1978 instead of JISX0208-1983. */ -#define CODING_FLAG_ISO_USE_OLDJIS 0x0080 +enum end_of_line_type + { + eol_lf, /* Line-feed only, same as Emacs' internal + format. */ + eol_crlf, /* Sequence of carriage-return and + line-feed. */ + eol_cr, /* Carriage-return only. */ + eol_any, /* Accept any of above. Produce line-feed + only. */ + eol_undecided, /* This value is used to denote that the + eol-type is not yet undecided. */ + eol_type_max + }; -/* If set, do not produce ISO6429's direction specifying sequence. */ -#define CODING_FLAG_ISO_NO_DIRECTION 0x0100 +/* Enumeration of index to an attribute vector of a coding system. */ -/* If set, assume designation states are reset at beginning of line on - output. */ -#define CODING_FLAG_ISO_INIT_AT_BOL 0x0200 +enum coding_attr_index + { + coding_attr_base_name, + coding_attr_docstring, + coding_attr_mnemonic, + coding_attr_type, + coding_attr_charset_list, + coding_attr_ascii_compat, + coding_attr_decode_tbl, + coding_attr_encode_tbl, + coding_attr_trans_tbl, + coding_attr_post_read, + coding_attr_pre_write, + coding_attr_default_char, + coding_attr_for_unibyte, + coding_attr_plist, + + coding_attr_category, + coding_attr_safe_charsets, + + /* The followings are extra attributes for each type. */ + coding_attr_charset_valids, + + coding_attr_ccl_decoder, + coding_attr_ccl_encoder, + coding_attr_ccl_valids, + + coding_attr_iso_initial, + coding_attr_iso_usage, + coding_attr_iso_request, + coding_attr_iso_flags, + + coding_attr_utf_16_bom, + coding_attr_utf_16_endian, + + coding_attr_emacs_mule_full, + + coding_attr_last_index + }; -/* If set, designation sequence should be placed at beginning of line - on output. */ -#define CODING_FLAG_ISO_DESIGNATE_AT_BOL 0x0400 -/* If set, do not encode unsafe characters on output. */ -#define CODING_FLAG_ISO_SAFE 0x0800 +/* Macros to access an element of an attribute vector. */ -/* If set, extra latin codes (128..159) are accepted as a valid code - on input. */ -#define CODING_FLAG_ISO_LATIN_EXTRA 0x1000 +#define CODING_ATTR_BASE_NAME(attrs) AREF (attrs, coding_attr_base_name) +#define CODING_ATTR_TYPE(attrs) AREF (attrs, coding_attr_type) +#define CODING_ATTR_CHARSET_LIST(attrs) AREF (attrs, coding_attr_charset_list) +#define CODING_ATTR_MNEMONIC(attrs) AREF (attrs, coding_attr_mnemonic) +#define CODING_ATTR_DOCSTRING(attrs) AREF (attrs, coding_attr_docstring) +#define CODING_ATTR_ASCII_COMPAT(attrs) AREF (attrs, coding_attr_ascii_compat) +#define CODING_ATTR_DECODE_TBL(attrs) AREF (attrs, coding_attr_decode_tbl) +#define CODING_ATTR_ENCODE_TBL(attrs) AREF (attrs, coding_attr_encode_tbl) +#define CODING_ATTR_TRANS_TBL(attrs) AREF (attrs, coding_attr_trans_tbl) +#define CODING_ATTR_POST_READ(attrs) AREF (attrs, coding_attr_post_read) +#define CODING_ATTR_PRE_WRITE(attrs) AREF (attrs, coding_attr_pre_write) +#define CODING_ATTR_DEFAULT_CHAR(attrs) AREF (attrs, coding_attr_default_char) +#define CODING_ATTR_FOR_UNIBYTE(attrs) AREF (attrs, coding_attr_for_unibyte) +#define CODING_ATTR_FLUSHING(attrs) AREF (attrs, coding_attr_flushing) +#define CODING_ATTR_PLIST(attrs) AREF (attrs, coding_attr_plist) +#define CODING_ATTR_CATEGORY(attrs) AREF (attrs, coding_attr_category) +#define CODING_ATTR_SAFE_CHARSETS(attrs)AREF (attrs, coding_attr_safe_charsets) -/* If set, use designation escape sequence. */ -#define CODING_FLAG_ISO_DESIGNATION 0x10000 -/* A character to be produced on output if encoding of the original - character is inhibitted by CODING_MODE_INHIBIT_UNENCODABLE_CHAR. - It must be an ASCII character. */ -#define CODING_REPLACEMENT_CHARACTER '?' +/* Return the name of a coding system specified by ID. */ +#define CODING_ID_NAME(id) \ + (HASH_KEY (XHASH_TABLE (Vcoding_system_hash_table), id)) -/* Structure of the field `spec.iso2022' in the structure `coding_system'. */ -struct iso2022_spec -{ - /* The current graphic register invoked to each graphic plane. */ - int current_invocation[2]; +/* Return the attribute vector of a coding system specified by ID. */ - /* The current charset designated to each graphic register. */ - int current_designation[4]; +#define CODING_ID_ATTRS(id) \ + (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 0)) - /* A charset initially designated to each graphic register. */ - int initial_designation[4]; +/* Return the list of aliases of a coding system specified by ID. */ - /* If not -1, it is a graphic register specified in an invalid - designation sequence. */ - int last_invalid_designation_register; +#define CODING_ID_ALIASES(id) \ + (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 1)) - /* A graphic register to which each charset should be designated. */ - unsigned char requested_designation[MAX_CHARSET + 1]; +/* Return the eol-type of a coding system specified by ID. */ - /* A revision number to be specified for each charset on encoding. - The value 255 means no revision number for the corresponding - charset. */ - unsigned char charset_revision_number[MAX_CHARSET + 1]; +#define CODING_ID_EOL_TYPE(id) \ + (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 2)) - /* Set to 1 temporarily only when graphic register 2 or 3 is invoked - by single-shift while encoding. */ - int single_shifting; - /* Set to 1 temporarily only when processing at beginning of line. */ - int bol; -}; +/* Return the spec vector of CODING_SYSTEM_SYMBOL. */ + +#define CODING_SYSTEM_SPEC(coding_system_symbol) \ + (Fgethash (coding_system_symbol, Vcoding_system_hash_table, Qnil)) + + +/* Return the ID of CODING_SYSTEM_SYMBOL. */ + +#define CODING_SYSTEM_ID(coding_system_symbol) \ + hash_lookup (XHASH_TABLE (Vcoding_system_hash_table), \ + coding_system_symbol, NULL) + +/* Return 1 if CODING_SYSTEM_SYMBOL is a coding system. */ + +#define CODING_SYSTEM_P(coding_system_symbol) \ + (CODING_SYSTEM_ID (coding_system_symbol) >= 0 \ + || (! NILP (coding_system_symbol) \ + && ! NILP (Fcoding_system_p (coding_system_symbol)))) + +/* Check if X is a coding system or not. */ + +#define CHECK_CODING_SYSTEM(x) \ + do { \ + if (CODING_SYSTEM_ID (x) < 0 \ + && NILP (Fcheck_coding_system (x))) \ + wrong_type_argument (Qcoding_system_p, (x)); \ + } while (0) + + +/* Check if X is a coding system or not. If it is, set SEPC to the + spec vector of the coding system. */ + +#define CHECK_CODING_SYSTEM_GET_SPEC(x, spec) \ + do { \ + spec = CODING_SYSTEM_SPEC (x); \ + if (NILP (spec)) \ + { \ + Fcheck_coding_system (x); \ + spec = CODING_SYSTEM_SPEC (x); \ + } \ + if (NILP (spec)) \ + x = wrong_type_argument (Qcoding_system_p, (x)); \ + } while (0) + + +/* Check if X is a coding system or not. If it is, set ID to the + ID of the coding system. */ + +#define CHECK_CODING_SYSTEM_GET_ID(x, id) \ + do \ + { \ + id = CODING_SYSTEM_ID (x); \ + if (id < 0) \ + { \ + Fcheck_coding_system (x); \ + id = CODING_SYSTEM_ID (x); \ + } \ + if (id < 0) \ + x = wrong_type_argument (Qcoding_system_p, (x)); \ + } while (0) -/* Macros to access each field in the structure `spec.iso2022'. */ -#define CODING_SPEC_ISO_INVOCATION(coding, plane) \ - (coding)->spec.iso2022.current_invocation[plane] -#define CODING_SPEC_ISO_DESIGNATION(coding, reg) \ - (coding)->spec.iso2022.current_designation[reg] -#define CODING_SPEC_ISO_INITIAL_DESIGNATION(coding, reg) \ - (coding)->spec.iso2022.initial_designation[reg] -#define CODING_SPEC_ISO_REQUESTED_DESIGNATION(coding, charset) \ - (coding)->spec.iso2022.requested_designation[charset] -#define CODING_SPEC_ISO_REVISION_NUMBER(coding, charset) \ - (coding)->spec.iso2022.charset_revision_number[charset] -#define CODING_SPEC_ISO_SINGLE_SHIFTING(coding) \ - (coding)->spec.iso2022.single_shifting -#define CODING_SPEC_ISO_BOL(coding) \ - (coding)->spec.iso2022.bol - -/* A value which may appear in - coding->spec.iso2022.requested_designation indicating that the - corresponding charset does not request any graphic register to be - designated. */ -#define CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION 4 - -/* Return a charset which is currently designated to the graphic plane - PLANE in the coding-system CODING. */ -#define CODING_SPEC_ISO_PLANE_CHARSET(coding, plane) \ - ((CODING_SPEC_ISO_INVOCATION (coding, plane) < 0) \ - ? -1 \ - : CODING_SPEC_ISO_DESIGNATION (coding, \ - CODING_SPEC_ISO_INVOCATION (coding, plane))) - -/*** BIG5 section ***/ - -/* Macros to denote each type of BIG5 coding system. */ -#define CODING_FLAG_BIG5_HKU 0x00 /* BIG5-HKU is one of variants of - BIG5 developed by Hong Kong - University. */ -#define CODING_FLAG_BIG5_ETEN 0x01 /* BIG5_ETen is one of variants - of BIG5 developed by the - company ETen in Taiwan. */ /*** GENERAL section ***/ -/* Types of coding system. */ -enum coding_type +/* Enumeration of result code of code conversion. */ +enum coding_result_code { - coding_type_no_conversion, /* A coding system which requires no - conversion for reading and writing - including end-of-line format. */ - coding_type_emacs_mule, /* A coding system used in Emacs' - buffer and string. Requires no - conversion for reading and writing - except for end-of-line format. */ - coding_type_undecided, /* A coding system which requires - automatic detection of a real - coding system. */ - coding_type_sjis, /* SJIS coding system for Japanese. */ - coding_type_iso2022, /* Any coding system of ISO2022 - variants. */ - coding_type_big5, /* BIG5 coding system for Chinese. */ - coding_type_ccl, /* The coding system of which decoder - and encoder are written in CCL. */ - coding_type_raw_text /* A coding system for a text - containing random 8-bit code which - does not require code conversion - except for end-of-line format. */ + CODING_RESULT_SUCCESS, + CODING_RESULT_INSUFFICIENT_SRC, + CODING_RESULT_INSUFFICIENT_DST, + CODING_RESULT_INCONSISTENT_EOL, + CODING_RESULT_INVALID_SRC, + CODING_RESULT_INTERRUPT, + CODING_RESULT_INSUFFICIENT_MEM }; -/* Formats of end-of-line. */ -#define CODING_EOL_LF 0 /* Line-feed only, same as Emacs' - internal format. */ -#define CODING_EOL_CRLF 1 /* Sequence of carriage-return and - line-feed. */ -#define CODING_EOL_CR 2 /* Carriage-return only. */ -#define CODING_EOL_UNDECIDED 3 /* This value is used to denote the - eol-type is not yet decided. */ -#define CODING_EOL_INCONSISTENT 4 /* This value is used to denote the - eol-type is not consistent - through the file. */ - -/* 1 if composing. */ -#define COMPOSING_P(coding) ((int) coding->composing > (int) COMPOSITION_NO) - -#define COMPOSITION_DATA_SIZE 4080 -#define COMPOSITION_DATA_MAX_BUNCH_LENGTH (4 + MAX_COMPOSITION_COMPONENTS*2) - -/* Data structure to hold information about compositions of text that - is being decoded or encode. ISO 2022 base code conversion routines - handle special ESC sequences for composition specification. But, - they can't get/put such information directly from/to a buffer in - the deepest place. So, they store or retrieve the information - through this structure. - - The encoder stores the information in this structure when it meets - ESC sequences for composition while encoding codes, then, after all - text codes are encoded, puts `composition' properties on the text - by referring to the structure. - - The decoder at first stores the information of a text to be - decoded, then, while decoding codes, generates ESC sequences for - composition at proper places by referring to the structure. */ - -struct composition_data -{ - /* The character position of the first character to be encoded or - decoded. START and END (see below) are relative to this - position. */ - int char_offset; - - /* The composition data. These elements are repeated for each - composition: - LENGTH START END METHOD [ COMPONENT ... ] - where, - LENGTH is the number of elements for this composition. - - START and END are starting and ending character positions of - the composition relative to `char_offset'. - - METHOD is one of `enum composing_status' specifying the way of - composition. - - COMPONENT is a character or an encoded composition rule. */ - int data[COMPOSITION_DATA_SIZE]; - - /* The number of elements in `data' currently used. */ - int used; - - /* Pointers to the previous and next structures. When `data' is - filled up, another structure is allocated and linked in `next'. - The new structure has backward link to this structure in `prev'. - The number of chained structures depends on how many compositions - the text being encoded or decoded contains. */ - struct composition_data *prev, *next; -}; - -/* Macros used for the member `result' of the struct - coding_system. */ -#define CODING_FINISH_NORMAL 0 -#define CODING_FINISH_INSUFFICIENT_SRC 1 -#define CODING_FINISH_INSUFFICIENT_DST 2 -#define CODING_FINISH_INCONSISTENT_EOL 3 -#define CODING_FINISH_INSUFFICIENT_CMP 4 -#define CODING_FINISH_INTERRUPT 5 /* Macros used for the member `mode' of the struct coding_system. */ @@ -334,7 +284,7 @@ struct composition_data #define CODING_MODE_INHIBIT_INCONSISTENT_EOL 0x01 /* If set, the decoding/encoding routines treat the current data as - the last block of the whole text to be converted, and do + the last block of the whole text to be converted, and do the appropriate finishing job. */ #define CODING_MODE_LAST_BLOCK 0x02 @@ -342,65 +292,106 @@ struct composition_data enables selective display. */ #define CODING_MODE_SELECTIVE_DISPLAY 0x04 -/* If set, replace unencodabae characters by `?' on encoding. */ -#define CODING_MODE_INHIBIT_UNENCODABLE_CHAR 0x08 - /* This flag is used by the decoding/encoding routines on the fly. If set, it means that right-to-left text is being processed. */ -#define CODING_MODE_DIRECTION 0x10 +#define CODING_MODE_DIRECTION 0x08 -struct coding_system +#define CODING_MODE_FIXED_DESTINATION 0x10 + +/* If set, it means that the encoding routines produces some safe + ASCII characters (usually '?') for unsupported characters. */ +#define CODING_MODE_SAFE_ENCODING 0x20 + +/* Structure of the field `spec.iso_2022' in the structure + `coding_system'. */ +struct iso_2022_spec { - /* Type of the coding system. */ - enum coding_type type; + /* Bit-wise-or of CODING_ISO_FLAG_XXX. */ + unsigned flags; - /* Type of end-of-line format (LF, CRLF, or CR) of the coding system. */ - int eol_type; + /* The current graphic register invoked to each graphic plane. */ + int current_invocation[2]; - /* Flag bits of the coding system. The meaning of each bit is common - to all types of coding systems. */ - unsigned int common_flags; + /* The current charset designated to each graphic register. The + value -1 means that not charset is designated, -2 means that + there was an invalid designation previously. */ + int current_designation[4]; - /* Flag bits of the coding system. The meaning of each bit depends - on the type of the coding system. */ - unsigned int flags; + /* Set to 1 temporarily only when graphic register 2 or 3 is invoked + by single-shift while encoding. */ + int single_shifting; - /* Mode bits of the coding system. See the comments of the macros - CODING_MODE_XXX. */ - unsigned int mode; + /* Set to 1 temporarily only when processing at beginning of line. */ + int bol; +}; + +struct ccl_spec; + +enum utf_16_bom_type + { + utf_16_detect_bom, + utf_16_without_bom, + utf_16_with_bom + }; + +enum utf_16_endian_type + { + utf_16_big_endian, + utf_16_little_endian + }; + +struct utf_16_spec +{ + enum utf_16_bom_type bom; + enum utf_16_endian_type endian; + int surrogate; +}; - /* The current status of composition handling. */ - int composing; +struct coding_detection_info +{ + /* Values of these members are bitwise-OR of CATEGORY_MASK_XXXs. */ + /* Which categories are already checked. */ + int checked; + /* Which categories are strongly found. */ + int found; + /* Which categories are rejected. */ + int rejected; +}; - /* 1 if the next character is a composition rule. */ - int composition_rule_follows; - /* Information of compositions are stored here on decoding and set - in advance on encoding. */ - struct composition_data *cmp_data; +struct coding_system +{ + /* ID number of the coding system. This is an index to + Vcoding_system_hash_table. This value is set by + setup_coding_system. At the early stage of building time, this + value is -1 in the array coding_categories to indicate that no + coding-system of that category is yet defined. */ + int id; - /* Index to cmp_data->data for the first element for the current - composition. */ - int cmp_data_start; + /* Flag bits of the coding system. The meaning of each bit is common + to all types of coding systems. */ + int common_flags; - /* Index to cmp_data->data for the current element for the current - composition. */ - int cmp_data_index; + /* Mode bits of the coding system. See the comments of the macros + CODING_MODE_XXX. */ + unsigned int mode; /* Detailed information specific to each type of coding system. */ - union spec + union { - struct iso2022_spec iso2022; - struct ccl_spec ccl; /* Defined in ccl.h. */ + struct iso_2022_spec iso_2022; + struct ccl_spec *ccl; /* Defined in ccl.h. */ + struct utf_16_spec utf_16; + int emacs_mule_full_support; } spec; - /* Index number of coding category of the coding system. */ - int category_idx; + int max_charset_id; + char *safe_charsets; - /* The following two members specify how characters 128..159 are - represented in source and destination text respectively. 1 means - they are represented by 2-byte sequence, 0 means they are - represented by 1-byte as is (see the comment in charset.h). */ + /* The following two members specify how binary 8-bit code 128..255 + are represented in source and destination text respectively. 1 + means they are represented by 2-byte sequence, 0 means they are + represented by 1-byte as is (see the comment in character.h). */ unsigned src_multibyte : 1; unsigned dst_multibyte : 1; @@ -408,173 +399,200 @@ struct coding_system -1 in setup_coding_system, and updated by detect_coding. So, when this is equal to the byte length of the text being converted, we can skip the actual conversion process. */ - int heading_ascii; + int head_ascii; /* The following members are set by encoding/decoding routine. */ - int produced, produced_char, consumed, consumed_char; + EMACS_INT produced, produced_char, consumed, consumed_char; /* Number of error source data found in a decoding routine. */ int errors; - /* Finish status of code conversion. It should be one of macros - CODING_FINISH_XXXX. */ - int result; + /* Store the positions of error source data. */ + EMACS_INT *error_positions; - /* If nonzero, suppress error notification. */ - int suppress_error; + /* Finish status of code conversion. */ + enum coding_result_code result; - /* The following members are all Lisp symbols. We don't have to - protect them from GC because the current garbage collection - doesn't relocate Lisp symbols. But, when it is changed, we must - find a way to protect them. */ + EMACS_INT src_pos, src_pos_byte, src_chars, src_bytes; + Lisp_Object src_object; + const unsigned char *source; - /* Backward pointer to the Lisp symbol of the coding system. */ - Lisp_Object symbol; + EMACS_INT dst_pos, dst_pos_byte, dst_bytes; + Lisp_Object dst_object; + unsigned char *destination; - /* Lisp function (symbol) to be called after decoding to do - additional conversion, or nil. */ - Lisp_Object post_read_conversion; + /* Set to 1 if the source of conversion is not in the member + `charbuf', but at `src_object'. */ + int chars_at_source; - /* Lisp function (symbol) to be called before encoding to do - additional conversion, or nil. */ - Lisp_Object pre_write_conversion; + /* If an element is non-negative, it is a character code. - /* Character translation tables to look up, or nil. */ - Lisp_Object translation_table_for_decode; - Lisp_Object translation_table_for_encode; -}; + If it is in the range -128..-1, it is a 8-bit character code + minus 256. + + If it is less than -128, it specifies the start of an annotation + chunk. The length of the chunk is -128 minus the value of the + element. The following elements are OFFSET, ANNOTATION-TYPE, and + a sequence of actual data for the annotation. OFFSET is a + character position offset from dst_pos or src_pos, + ANNOTATION-TYPE specfies the meaning of the annotation and how to + handle the following data.. */ + int *charbuf; + int charbuf_size, charbuf_used; + + /* Set to 1 if charbuf contains an annotation. */ + int annotated; + + unsigned char carryover[64]; + int carryover_bytes; + + int default_char; -/* Mask bits for (struct coding_system *)->common_flags. */ -#define CODING_REQUIRE_FLUSHING_MASK 0x01 -#define CODING_REQUIRE_DECODING_MASK 0x02 -#define CODING_REQUIRE_ENCODING_MASK 0x04 -#define CODING_REQUIRE_DETECTION_MASK 0x08 -#define CODING_ASCII_INCOMPATIBLE_MASK 0x10 + int (*detector) P_ ((struct coding_system *, + struct coding_detection_info *)); + void (*decoder) P_ ((struct coding_system *)); + int (*encoder) P_ ((struct coding_system *)); +}; -/* Return 1 if the coding system CODING requires specific code to be +/* Meanings of bits in the member `common_flags' of the structure + coding_system. The lowest 8 bits are reserved for various kind of + annotations (currently two of them are used). */ +#define CODING_ANNOTATION_MASK 0x00FF +#define CODING_ANNOTATE_COMPOSITION_MASK 0x0001 +#define CODING_ANNOTATE_DIRECTION_MASK 0x0002 +#define CODING_ANNOTATE_CHARSET_MASK 0x0003 +#define CODING_FOR_UNIBYTE_MASK 0x0100 +#define CODING_REQUIRE_FLUSHING_MASK 0x0200 +#define CODING_REQUIRE_DECODING_MASK 0x0400 +#define CODING_REQUIRE_ENCODING_MASK 0x0800 +#define CODING_REQUIRE_DETECTION_MASK 0x1000 +#define CODING_RESET_AT_BOL_MASK 0x2000 + +/* Return 1 if the coding context CODING requires annotaion + handling. */ +#define CODING_REQUIRE_ANNOTATION(coding) \ + ((coding)->common_flags & CODING_ANNOTATION_MASK) + +/* Return 1 if the coding context CODING prefers decoding into unibyte. */ +#define CODING_FOR_UNIBYTE(coding) \ + ((coding)->common_flags & CODING_FOR_UNIBYTE_MASK) + +/* Return 1 if the coding context CODING requires specific code to be attached at the tail of converted text. */ #define CODING_REQUIRE_FLUSHING(coding) \ ((coding)->common_flags & CODING_REQUIRE_FLUSHING_MASK) -/* Return 1 if the coding system CODING requires code conversion on +/* Return 1 if the coding context CODING requires code conversion on decoding. */ #define CODING_REQUIRE_DECODING(coding) \ ((coding)->dst_multibyte \ || (coding)->common_flags & CODING_REQUIRE_DECODING_MASK) -/* Return 1 if the coding system CODING requires code conversion on + +/* Return 1 if the coding context CODING requires code conversion on encoding. The non-multibyte part of the condition is to support encoding of unibyte strings/buffers generated by string-as-unibyte or (set-buffer-multibyte nil) from multibyte strings/buffers. */ -#define CODING_REQUIRE_ENCODING(coding) \ - ((coding)->src_multibyte \ - || (coding)->common_flags & CODING_REQUIRE_ENCODING_MASK) +#define CODING_REQUIRE_ENCODING(coding) \ + ((coding)->src_multibyte \ + || (coding)->common_flags & CODING_REQUIRE_ENCODING_MASK \ + || (coding)->mode & CODING_MODE_SELECTIVE_DISPLAY) -/* Return 1 if the coding system CODING requires some kind of code + +/* Return 1 if the coding context CODING requires some kind of code detection. */ #define CODING_REQUIRE_DETECTION(coding) \ ((coding)->common_flags & CODING_REQUIRE_DETECTION_MASK) -/* Return 1 if the coding system CODING requires code conversion on +/* Return 1 if the coding context CODING requires code conversion on decoding or some kind of code detection. */ #define CODING_MAY_REQUIRE_DECODING(coding) \ (CODING_REQUIRE_DECODING (coding) \ || CODING_REQUIRE_DETECTION (coding)) -/* Index for each coding category in `coding_category_table' */ -#define CODING_CATEGORY_IDX_EMACS_MULE 0 -#define CODING_CATEGORY_IDX_SJIS 1 -#define CODING_CATEGORY_IDX_ISO_7 2 -#define CODING_CATEGORY_IDX_ISO_7_TIGHT 3 -#define CODING_CATEGORY_IDX_ISO_8_1 4 -#define CODING_CATEGORY_IDX_ISO_8_2 5 -#define CODING_CATEGORY_IDX_ISO_7_ELSE 6 -#define CODING_CATEGORY_IDX_ISO_8_ELSE 7 -#define CODING_CATEGORY_IDX_CCL 8 -#define CODING_CATEGORY_IDX_BIG5 9 -#define CODING_CATEGORY_IDX_UTF_8 10 -#define CODING_CATEGORY_IDX_UTF_16_BE 11 -#define CODING_CATEGORY_IDX_UTF_16_LE 12 -#define CODING_CATEGORY_IDX_RAW_TEXT 13 -#define CODING_CATEGORY_IDX_BINARY 14 -#define CODING_CATEGORY_IDX_MAX 15 - -/* Definitions of flag bits returned by the function - detect_coding_mask (). */ -#define CODING_CATEGORY_MASK_EMACS_MULE (1 << CODING_CATEGORY_IDX_EMACS_MULE) -#define CODING_CATEGORY_MASK_SJIS (1 << CODING_CATEGORY_IDX_SJIS) -#define CODING_CATEGORY_MASK_ISO_7 (1 << CODING_CATEGORY_IDX_ISO_7) -#define CODING_CATEGORY_MASK_ISO_7_TIGHT (1 << CODING_CATEGORY_IDX_ISO_7_TIGHT) -#define CODING_CATEGORY_MASK_ISO_8_1 (1 << CODING_CATEGORY_IDX_ISO_8_1) -#define CODING_CATEGORY_MASK_ISO_8_2 (1 << CODING_CATEGORY_IDX_ISO_8_2) -#define CODING_CATEGORY_MASK_ISO_7_ELSE (1 << CODING_CATEGORY_IDX_ISO_7_ELSE) -#define CODING_CATEGORY_MASK_ISO_8_ELSE (1 << CODING_CATEGORY_IDX_ISO_8_ELSE) -#define CODING_CATEGORY_MASK_CCL (1 << CODING_CATEGORY_IDX_CCL) -#define CODING_CATEGORY_MASK_BIG5 (1 << CODING_CATEGORY_IDX_BIG5) -#define CODING_CATEGORY_MASK_UTF_8 (1 << CODING_CATEGORY_IDX_UTF_8) -#define CODING_CATEGORY_MASK_UTF_16_BE (1 << CODING_CATEGORY_IDX_UTF_16_BE) -#define CODING_CATEGORY_MASK_UTF_16_LE (1 << CODING_CATEGORY_IDX_UTF_16_LE) -#define CODING_CATEGORY_MASK_RAW_TEXT (1 << CODING_CATEGORY_IDX_RAW_TEXT) -#define CODING_CATEGORY_MASK_BINARY (1 << CODING_CATEGORY_IDX_BINARY) - -/* This value is returned if detect_coding_mask () find nothing other - than ASCII characters. */ -#define CODING_CATEGORY_MASK_ANY \ - ( CODING_CATEGORY_MASK_EMACS_MULE \ - | CODING_CATEGORY_MASK_SJIS \ - | CODING_CATEGORY_MASK_ISO_7 \ - | CODING_CATEGORY_MASK_ISO_7_TIGHT \ - | CODING_CATEGORY_MASK_ISO_8_1 \ - | CODING_CATEGORY_MASK_ISO_8_2 \ - | CODING_CATEGORY_MASK_ISO_7_ELSE \ - | CODING_CATEGORY_MASK_ISO_8_ELSE \ - | CODING_CATEGORY_MASK_CCL \ - | CODING_CATEGORY_MASK_BIG5 \ - | CODING_CATEGORY_MASK_UTF_8 \ - | CODING_CATEGORY_MASK_UTF_16_BE \ - | CODING_CATEGORY_MASK_UTF_16_LE) - -#define CODING_CATEGORY_MASK_ISO_7BIT \ - (CODING_CATEGORY_MASK_ISO_7 | CODING_CATEGORY_MASK_ISO_7_TIGHT) - -#define CODING_CATEGORY_MASK_ISO_8BIT \ - (CODING_CATEGORY_MASK_ISO_8_1 | CODING_CATEGORY_MASK_ISO_8_2) - -#define CODING_CATEGORY_MASK_ISO_SHIFT \ - (CODING_CATEGORY_MASK_ISO_7_ELSE | CODING_CATEGORY_MASK_ISO_8_ELSE) - -#define CODING_CATEGORY_MASK_ISO \ - ( CODING_CATEGORY_MASK_ISO_7BIT \ - | CODING_CATEGORY_MASK_ISO_SHIFT \ - | CODING_CATEGORY_MASK_ISO_8BIT) - -#define CODING_CATEGORY_MASK_UTF_16_BE_LE \ - (CODING_CATEGORY_MASK_UTF_16_BE | CODING_CATEGORY_MASK_UTF_16_LE) - /* Macros to decode or encode a character of JISX0208 in SJIS. S1 and S2 are the 1st and 2nd position-codes of JISX0208 in SJIS coding system. C1 and C2 are the 1st and 2nd position codes of Emacs' internal format. */ -#define DECODE_SJIS(s1, s2, c1, c2) \ - do { \ - if (s2 >= 0x9F) \ - c1 = s1 * 2 - (s1 >= 0xE0 ? 0x160 : 0xE0), \ - c2 = s2 - 0x7E; \ - else \ - c1 = s1 * 2 - ((s1 >= 0xE0) ? 0x161 : 0xE1), \ - c2 = s2 - ((s2 >= 0x7F) ? 0x20 : 0x1F); \ +#define SJIS_TO_JIS(code) \ + do { \ + int s1, s2, j1, j2; \ + \ + s1 = (code) >> 8, s2 = (code) & 0xFF; \ + \ + if (s2 >= 0x9F) \ + (j1 = s1 * 2 - (s1 >= 0xE0 ? 0x160 : 0xE0), \ + j2 = s2 - 0x7E); \ + else \ + (j1 = s1 * 2 - ((s1 >= 0xE0) ? 0x161 : 0xE1), \ + j2 = s2 - ((s2 >= 0x7F) ? 0x20 : 0x1F)); \ + (code) = (j1 << 8) | j2; \ + } while (0) + +#define SJIS_TO_JIS2(code) \ + do { \ + int s1, s2, j1, j2; \ + \ + s1 = (code) >> 8, s2 = (code) & 0xFF; \ + \ + if (s2 >= 0x9F) \ + { \ + j1 = (s1 == 0xF0 ? 0x28 \ + : s1 == 0xF1 ? 0x24 \ + : s1 == 0xF2 ? 0x2C \ + : s1 == 0xF3 ? 0x2E \ + : 0x6E + (s1 - 0xF4) * 2); \ + j2 = s2 - 0x7E; \ + } \ + else \ + { \ + j1 = (s1 <= 0xF2 ? 0x21 + (s1 - 0xF0) * 2 \ + : s1 <= 0xF4 ? 0x2D + (s1 - 0xF3) * 2 \ + : 0x6F + (s1 - 0xF5) * 2); \ + j2 = s2 - ((s2 >= 0x7F ? 0x20 : 0x1F)); \ + } \ + (code) = (j1 << 8) | j2; \ + } while (0) + + +#define JIS_TO_SJIS(code) \ + do { \ + int s1, s2, j1, j2; \ + \ + j1 = (code) >> 8, j2 = (code) & 0xFF; \ + if (j1 & 1) \ + (s1 = j1 / 2 + ((j1 < 0x5F) ? 0x71 : 0xB1), \ + s2 = j2 + ((j2 >= 0x60) ? 0x20 : 0x1F)); \ + else \ + (s1 = j1 / 2 + ((j1 < 0x5F) ? 0x70 : 0xB0), \ + s2 = j2 + 0x7E); \ + (code) = (s1 << 8) | s2; \ } while (0) -#define ENCODE_SJIS(c1, c2, s1, s2) \ +#define JIS_TO_SJIS2(code) \ do { \ - if (c1 & 1) \ - s1 = c1 / 2 + ((c1 < 0x5F) ? 0x71 : 0xB1), \ - s2 = c2 + ((c2 >= 0x60) ? 0x20 : 0x1F); \ + int s1, s2, j1, j2; \ + \ + j1 = (code) >> 8, j2 = (code) & 0xFF; \ + if (j1 & 1) \ + { \ + s1 = (j1 <= 0x25 ? 0xF0 + (j1 - 0x21) / 2 \ + : j1 <= 0x27 ? 0xF3 + (j1 - 0x2D) / 2 \ + : 0xF5 + (j1 - 0x6F) / 2); \ + s2 = j2 + ((j2 >= 0x60) ? 0x20 : 0x1F); \ + } \ else \ - s1 = c1 / 2 + ((c1 < 0x5F) ? 0x70 : 0xB0), \ - s2 = c2 + 0x7E; \ + { \ + s1 = (j1 == 0x28 ? 0xF0 \ + : j1 == 0x24 ? 0xF1 \ + : j1 == 0x2C ? 0xF2 \ + : j1 == 0x2E ? 0xF3 \ + : 0xF4 + (j1 - 0x6E) / 2); \ + s2 = j2 + 0x7E; \ + } \ + (code) = (s1 << 8) | s2; \ } while (0) /* Encode the file name NAME using the specified coding system @@ -588,6 +606,7 @@ struct coding_system ? code_convert_string_norecord (name, Vdefault_file_name_coding_system, 1) \ : name)) + /* Decode the file name NAME using the specified coding system for file names, if any. */ #define DECODE_FILE(name) \ @@ -599,6 +618,7 @@ struct coding_system ? code_convert_string_norecord (name, Vdefault_file_name_coding_system, 0) \ : name)) + /* Encode the string STR using the specified coding system for system functions, if any. */ #define ENCODE_SYSTEM(str) \ @@ -615,54 +635,83 @@ struct coding_system ? code_convert_string_norecord (str, Vlocale_coding_system, 0) \ : str) +/* Used by the gtk menu code. Note that this encodes utf-8, not + utf-8-emacs, so it's not a no-op. */ #define ENCODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 1) /* Extern declarations. */ -extern int decode_coding P_ ((struct coding_system *, const unsigned char *, - unsigned char *, int, int)); -extern int encode_coding P_ ((struct coding_system *, const unsigned char *, - unsigned char *, int, int)); -extern void coding_save_composition P_ ((struct coding_system *, int, int, - Lisp_Object)); -extern void coding_free_composition_data P_ ((struct coding_system *)); -extern void coding_adjust_composition_offset P_ ((struct coding_system *, - int)); -extern void coding_allocate_composition_data P_ ((struct coding_system *, - int)); -extern void coding_restore_composition P_ ((struct coding_system *, - Lisp_Object)); -extern int code_convert_region P_ ((int, int, int, int, struct coding_system *, - int, int)); -extern Lisp_Object run_pre_post_conversion_on_str P_ ((Lisp_Object, - struct coding_system *, - int)); -extern void run_pre_write_conversin_on_c_str P_ ((unsigned char **, int *, - int, int, - struct coding_system *)); - +extern Lisp_Object code_conversion_save P_ ((int, int)); extern int decoding_buffer_size P_ ((struct coding_system *, int)); extern int encoding_buffer_size P_ ((struct coding_system *, int)); -extern void detect_coding P_ ((struct coding_system *, const unsigned char *, - int)); -extern void detect_eol P_ ((struct coding_system *, const unsigned char *, - int)); -extern int setup_coding_system P_ ((Lisp_Object, struct coding_system *)); -extern Lisp_Object code_convert_string P_ ((Lisp_Object, - struct coding_system *, int, int)); -extern Lisp_Object code_convert_string1 P_ ((Lisp_Object, Lisp_Object, - Lisp_Object, int)); +extern void setup_coding_system P_ ((Lisp_Object, struct coding_system *)); +extern Lisp_Object coding_charset_list P_ ((struct coding_system *)); +extern void detect_coding P_ ((struct coding_system *)); +extern Lisp_Object code_convert_region P_ ((Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object, + int, int)); +extern Lisp_Object code_convert_string P_ ((Lisp_Object, Lisp_Object, + Lisp_Object, int, int, int)); extern Lisp_Object code_convert_string_norecord P_ ((Lisp_Object, Lisp_Object, int)); -extern void setup_raw_text_coding_system P_ ((struct coding_system *)); -extern Lisp_Object encode_coding_string P_ ((Lisp_Object, - struct coding_system *, int)); -extern Lisp_Object decode_coding_string P_ ((Lisp_Object, - struct coding_system *, int)); +extern Lisp_Object raw_text_coding_system P_ ((Lisp_Object)); +extern Lisp_Object coding_inherit_eol_type P_ ((Lisp_Object, Lisp_Object)); + +extern int decode_coding_gap P_ ((struct coding_system *, + EMACS_INT, EMACS_INT)); +extern int encode_coding_gap P_ ((struct coding_system *, + EMACS_INT, EMACS_INT)); +extern void decode_coding_object P_ ((struct coding_system *, + Lisp_Object, EMACS_INT, EMACS_INT, + EMACS_INT, EMACS_INT, Lisp_Object)); +extern void encode_coding_object P_ ((struct coding_system *, + Lisp_Object, EMACS_INT, EMACS_INT, + EMACS_INT, EMACS_INT, Lisp_Object)); + +/* Macros for backward compatibility. */ + +#define decode_coding_region(coding, from, to) \ + decode_coding_object (coding, Fcurrent_buffer (), \ + from, CHAR_TO_BYTE (from), \ + to, CHAR_TO_BYTE (to), Fcurrent_buffer ()) + + +#define encode_coding_region(coding, from, to) \ + encode_coding_object (coding, Fcurrent_buffer (), \ + from, CHAR_TO_BYTE (from), \ + to, CHAR_TO_BYTE (to), Fcurrent_buffer ()) + + +#define decode_coding_string(coding, string, nocopy) \ + decode_coding_object (coding, string, 0, 0, XSTRING (string)->size, \ + STRING_BYTES (XSTRING (string)), Qt) + +#define encode_coding_string(coding, string, nocopy) \ + (encode_coding_object (coding, string, 0, 0, XSTRING (string)->size, \ + STRING_BYTES (XSTRING (string)), Qt), \ + (coding)->dst_object) + + +#define decode_coding_c_string(coding, src, bytes, dst_object) \ + do { \ + (coding)->source = (src); \ + (coding)->src_chars = (coding)->src_bytes = (bytes); \ + decode_coding_object ((coding), Qnil, 0, 0, (bytes), (bytes), \ + (dst_object)); \ + } while (0) + + +extern Lisp_Object preferred_coding_system P_ (()); + + +extern Lisp_Object Qutf_8, Qutf_8_emacs; + extern Lisp_Object Qcoding_system, Qeol_type, Qcoding_category_index; -extern Lisp_Object Qraw_text, Qemacs_mule; +extern Lisp_Object Qcoding_system_p; +extern Lisp_Object Qraw_text, Qemacs_mule, Qno_conversion, Qundecided; +extern Lisp_Object Qiso_2022; extern Lisp_Object Qbuffer_file_coding_system; -extern Lisp_Object Vcoding_category_list; -extern Lisp_Object Qutf_8; + +extern Lisp_Object Qunix, Qdos, Qmac; extern Lisp_Object Qtranslation_table; extern Lisp_Object Qtranslation_table_id; @@ -672,9 +721,6 @@ extern Lisp_Object eol_mnemonic_unix, eol_mnemonic_dos, eol_mnemonic_mac; /* Mnemonic string to indicate type of end-of-line is not yet decided. */ extern Lisp_Object eol_mnemonic_undecided; -/* Format of end-of-line decided by system. */ -extern int system_eol_type; - #ifdef emacs extern Lisp_Object Qfile_coding_system; extern Lisp_Object Qcall_process, Qcall_process_region; @@ -700,13 +746,10 @@ extern int inherit_process_coding_system; terminal coding system is nil. */ extern struct coding_system safe_terminal_coding; -/* Default coding system to be used to write a file. */ -extern struct coding_system default_buffer_file_coding; - /* Default coding systems used for process I/O. */ extern Lisp_Object Vdefault_process_coding_system; -/* Function to call to force a user to force select a proper coding +/* Function to call to force a user to force select a propert coding system. */ extern Lisp_Object Vselect_safe_coding_system_function; @@ -726,6 +769,9 @@ extern Lisp_Object Vdefault_file_name_coding_system; /* Error signaled when there's a problem with detecting coding system */ extern Lisp_Object Qcoding_system_error; +extern char emacs_mule_bytes[256]; +extern int emacs_mule_string_char P_ ((unsigned char *)); + #endif /* EMACS_CODING_H */ /* arch-tag: 2bc3b4fa-6870-4f64-8135-b962b2d290e4 diff --git a/src/composite.c b/src/composite.c index 95c19d74560..921640c2eb1 100644 --- a/src/composite.c +++ b/src/composite.c @@ -4,6 +4,9 @@ Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003, 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -25,7 +28,7 @@ Boston, MA 02110-1301, USA. */ #include <config.h> #include "lisp.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "intervals.h" /* Emacs uses special text property `composition' to support character @@ -147,19 +150,17 @@ Lisp_Object composition_hash_table; /* Function to call to adjust composition. */ Lisp_Object Vcompose_chars_after_function; -/* Char-table of patterns and functions to make a composition. */ -Lisp_Object Vcomposition_function_table; -Lisp_Object Qcomposition_function_table; +Lisp_Object Qauto_composed; +Lisp_Object Vauto_composition_function; +Lisp_Object Qauto_composition_function; + +EXFUN (Fremove_list_of_text_properties, 4); /* Temporary variable used in macros COMPOSITION_XXX. */ Lisp_Object composition_temp; - -/* Return how many columns C will occupy on the screen. It always - returns 1 for control characters and 8-bit characters because those - are just ignored in a composition. */ -#define CHAR_WIDTH(c) \ - (SINGLE_BYTE_CHAR_P (c) ? 1 : CHARSET_WIDTH (CHAR_CHARSET (c))) +extern int enable_font_backend; + /* Return COMPOSITION-ID of a composition at buffer position CHARPOS/BYTEPOS and length NCHARS. The `composition' property of the sequence is PROP. STRING, if non-nil, is a string that @@ -274,6 +275,22 @@ get_composition_id (charpos, bytepos, nchars, prop, string) /* Check if the contents of COMPONENTS are valid if COMPONENTS is a vector or a list. It should be a sequence of: char1 rule1 char2 rule2 char3 ... ruleN charN+1 */ + +#ifdef USE_FONT_BACKEND + if (enable_font_backend + && VECTORP (components) + && ASIZE (components) >= 2 + && VECTORP (AREF (components, 0))) + { + /* COMPONENTS is a glyph-string. */ + int len = ASIZE (key); + + for (i = 1; i < len; i++) + if (! VECTORP (AREF (key, i))) + goto invalid_composition; + } + else +#endif /* USE_FONT_BACKEND */ if (VECTORP (components) || CONSP (components)) { int len = XVECTOR (key)->size; @@ -307,6 +324,12 @@ get_composition_id (charpos, bytepos, nchars, prop, string) : ((INTEGERP (components) || STRINGP (components)) ? COMPOSITION_WITH_ALTCHARS : COMPOSITION_WITH_RULE_ALTCHARS)); +#ifdef USE_FONT_BACKEND + if (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS + && VECTORP (components) + && ! INTEGERP (AREF (components, 0))) + cmp->method = COMPOSITION_WITH_GLYPH_STRING; +#endif /* USE_FONT_BACKEND */ cmp->hash_index = hash_index; glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS ? (XVECTOR (key)->size + 1) / 2 @@ -315,6 +338,14 @@ get_composition_id (charpos, bytepos, nchars, prop, string) cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2); cmp->font = NULL; +#ifdef USE_FONT_BACKEND + if (cmp->method == COMPOSITION_WITH_GLYPH_STRING) + { + cmp->width = 1; /* Should be fixed later. */ + cmp->glyph_len--; + } + else +#endif /* USE_FONT_BACKEND */ /* Calculate the width of overall glyphs of the composition. */ if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS) { @@ -335,17 +366,17 @@ get_composition_id (charpos, bytepos, nchars, prop, string) float leftmost = 0.0, rightmost; ch = XINT (key_contents[0]); - rightmost = CHAR_WIDTH (ch); + rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1; for (i = 1; i < glyph_len; i += 2) { - int rule, gref, nref; + int rule, gref, nref, xoff, yoff; int this_width; float this_left; rule = XINT (key_contents[i]); ch = XINT (key_contents[i + 1]); - this_width = CHAR_WIDTH (ch); + this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1; /* A composition rule is specified by an integer value that encodes global and new reference points (GREF and @@ -361,7 +392,7 @@ get_composition_id (charpos, bytepos, nchars, prop, string) | | 6---7---8 -- descent */ - COMPOSITION_DECODE_RULE (rule, gref, nref); + COMPOSITION_DECODE_RULE (rule, gref, nref, xoff, yoff); this_left = (leftmost + (gref % 3) * (rightmost - leftmost) / 2.0 - (nref % 3) * this_width / 2.0); @@ -407,7 +438,8 @@ get_composition_id (charpos, bytepos, nchars, prop, string) int find_composition (pos, limit, start, end, prop, object) - int pos, limit, *start, *end; + int pos, limit; + EMACS_INT *start, *end; Lisp_Object *prop, object; { Lisp_Object val; @@ -451,7 +483,7 @@ run_composition_function (from, to, prop) Lisp_Object prop; { Lisp_Object func; - int start, end; + EMACS_INT start, end; func = COMPOSITION_MODIFICATION_FUNC (prop); /* If an invalid composition precedes or follows, try to make them @@ -466,24 +498,29 @@ run_composition_function (from, to, prop) to = end; if (!NILP (Ffboundp (func))) call2 (func, make_number (from), make_number (to)); - else if (!NILP (Ffboundp (Vcompose_chars_after_function))) - call3 (Vcompose_chars_after_function, - make_number (from), make_number (to), Qnil); } /* Make invalid compositions adjacent to or inside FROM and TO valid. CHECK_MASK is bitwise `or' of mask bits defined by macros CHECK_XXX (see the comment in composite.h). + It also resets the text-property `auto-composed' to a proper region + so that automatic character composition works correctly later while + displaying the region. + This function is called when a buffer text is changed. If the change is deletion, FROM == TO. Otherwise, FROM < TO. */ void update_compositions (from, to, check_mask) - int from, to, check_mask; + EMACS_INT from, to; + int check_mask; { Lisp_Object prop; - int start, end; + EMACS_INT start, end; + /* The beginning and end of the region to set the property + `auto-composed' to nil. */ + EMACS_INT min_pos = from, max_pos = to; if (inhibit_modification_hooks) return; @@ -503,6 +540,9 @@ update_compositions (from, to, check_mask) && find_composition (from - 1, -1, &start, &end, &prop, Qnil) && COMPOSITION_VALID_P (start, end, prop)) { + min_pos = start; + if (end > to) + max_pos = end; if (from < end) Fput_text_property (make_number (from), make_number (end), Qcomposition, @@ -513,7 +553,11 @@ update_compositions (from, to, check_mask) else if (from < ZV && find_composition (from, -1, &start, &from, &prop, Qnil) && COMPOSITION_VALID_P (start, from, prop)) - run_composition_function (start, from, prop); + { + if (from > to) + max_pos = from; + run_composition_function (start, from, prop); + } } if (check_mask & CHECK_INSIDE) @@ -540,15 +584,33 @@ update_compositions (from, to, check_mask) To avoid it, in such a case, we change the property of the former to the copy of it. */ if (to < end) - Fput_text_property (make_number (start), make_number (to), - Qcomposition, - Fcons (XCAR (prop), XCDR (prop)), Qnil); + { + Fput_text_property (make_number (start), make_number (to), + Qcomposition, + Fcons (XCAR (prop), XCDR (prop)), Qnil); + max_pos = end; + } run_composition_function (start, end, prop); } else if (to < ZV && find_composition (to, -1, &start, &end, &prop, Qnil) && COMPOSITION_VALID_P (start, end, prop)) - run_composition_function (start, end, prop); + { + run_composition_function (start, end, prop); + max_pos = end; + } + } + if (min_pos < max_pos) + { + int count = SPECPDL_INDEX (); + + specbind (Qinhibit_read_only, Qt); + specbind (Qinhibit_modification_hooks, Qt); + specbind (Qinhibit_point_motion_hooks, Qt); + Fremove_list_of_text_properties (make_number (min_pos), + make_number (max_pos), + Fcons (Qauto_composed, Qnil), Qnil); + unbind_to (count, Qnil); } } @@ -590,12 +652,17 @@ compose_text (start, end, components, modification_func, string) { Lisp_Object prop; +#if 0 + if (VECTORP (components) && ASIZE (components) > 1 + && VECTORP (AREF (components, 0))) + prop = components; + else +#endif /* USE_FONT_BACKEND */ prop = Fcons (Fcons (make_number (end - start), components), modification_func); Fput_text_property (make_number (start), make_number (end), Qcomposition, prop, string); } - /* Emacs Lisp APIs. */ @@ -653,7 +720,7 @@ See `find-composition' for more detail. */) Lisp_Object pos, limit, string, detail_p; { Lisp_Object prop, tail; - int start, end; + EMACS_INT start, end; int id; CHECK_NUMBER_COERCE_MARKER (pos); @@ -732,12 +799,12 @@ syms_of_composite () args[0] = QCtest; args[1] = Qequal; + args[2] = QCweakness; /* We used to make the hash table weak so that unreferenced compostions can be garbage-collected. But, usually once created compositions are repeatedly used in an Emacs session, and thus it's not worth to save memory in such a way. So, we make the table not weak. */ - args[2] = QCweakness; args[3] = Qnil; args[4] = QCsize; args[5] = make_number (311); @@ -763,29 +830,24 @@ valid. The default value is the function `compose-chars-after'. */); Vcompose_chars_after_function = intern ("compose-chars-after"); - Qcomposition_function_table = intern ("composition-function-table"); - staticpro (&Qcomposition_function_table); - - /* Intern this now in case it isn't already done. - Setting this variable twice is harmless. - But don't staticpro it here--that is done in alloc.c. */ - Qchar_table_extra_slots = intern ("char-table-extra-slots"); + Qauto_composed = intern ("auto-composed"); + staticpro (&Qauto_composed); - Fput (Qcomposition_function_table, Qchar_table_extra_slots, make_number (0)); + Qauto_composition_function = intern ("auto-composition-function"); + staticpro (&Qauto_composition_function); - DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table, - doc: /* Char table of patterns and functions to make a composition. + DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function, + doc: /* Function to call to compose characters automatically. +The function is called from the display routine with four arguments, +FROM, TO, WINDOW, and STRING. -Each element is nil or an alist of PATTERNs vs FUNCs, where PATTERNs -are regular expressions and FUNCs are functions. FUNC is responsible -for composing text matching the corresponding PATTERN. FUNC is called -with three arguments FROM, TO, and PATTERN. See the function -`compose-chars-after' for more detail. +If STRING is nil, the function must compose characters in the region +between FROM and TO in the current buffer. -This table is looked up by the first character of a composition when -the composition gets invalid after a change in a buffer. */); - Vcomposition_function_table - = Fmake_char_table (Qcomposition_function_table, Qnil); +Otherwise, STRING is a string, and FROM and TO are indices into the +string. In this case, the function must compose characters in the +string. */); + Vauto_composition_function = Qnil; defsubr (&Scompose_region_internal); defsubr (&Scompose_string_internal); diff --git a/src/composite.h b/src/composite.h index ba8f8c84104..eb60f1d2ecd 100644 --- a/src/composite.h +++ b/src/composite.h @@ -4,6 +4,9 @@ Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003, 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -25,22 +28,22 @@ Boston, MA 02110-1301, USA. */ #ifndef EMACS_COMPOSITE_H #define EMACS_COMPOSITE_H -/* Methods to display a sequence of components a composition. */ +/* Methods to display a sequence of components of a composition. */ enum composition_method { - /* The first two are actually not methods, but used in code - conversion to specify the current composing status. */ - COMPOSITION_DISABLED, /* Never handle composition data */ - COMPOSITION_NO, /* Not processing composition data */ /* Compose relatively without alternate characters. */ COMPOSITION_RELATIVE, - /* Compose by specified composition rule. This is not used in Emacs - 21 but we need it to decode files saved in the older versions of - Emacs. */ + /* Compose by specified composition rules. This is not used in + Emacs 21 but we need it to decode files saved in the older + versions of Emacs. */ COMPOSITION_WITH_RULE, /* Compose relatively with alternate characters. */ COMPOSITION_WITH_ALTCHARS, - /* Compose by specified composition rule with alternate characters. */ - COMPOSITION_WITH_RULE_ALTCHARS + /* Compose by specified composition rules with alternate characters. */ + COMPOSITION_WITH_RULE_ALTCHARS, + /* Compose by specified lispy glyph-string. */ + COMPOSITION_WITH_GLYPH_STRING, + /* This is not a method. */ + COMPOSITION_NO }; /* Maximum number of compoments a single composition can have. */ @@ -87,9 +90,13 @@ extern Lisp_Object composition_temp; : (composition_temp = XCDR (XCAR (prop)), \ (NILP (composition_temp) \ ? COMPOSITION_RELATIVE \ - : ((INTEGERP (composition_temp) || STRINGP (composition_temp)) \ - ? COMPOSITION_WITH_ALTCHARS \ - : COMPOSITION_WITH_RULE_ALTCHARS)))) + : (INTEGERP (composition_temp) || STRINGP (composition_temp)) \ + ? COMPOSITION_WITH_ALTCHARS \ + : (VECTORP (composition_temp) \ + && ASIZE (composition_temp) >= 2 \ + && VECTORP (AREF (composition_temp, 0))) \ + ? COMPOSITION_WITH_GLYPH_STRING \ + : COMPOSITION_WITH_RULE_ALTCHARS))) /* Return 1 if the composition is valid. It is valid if length of the composition equals to (END - START). */ @@ -128,13 +135,19 @@ extern Lisp_Object composition_temp; ->contents[(n) * 2 - 1]) /* Decode encoded composition rule RULE_CODE into GREF (global - reference point code) and NREF (new reference point code). Don't - check RULE_CODE, always set GREF and NREF to valid values. */ -#define COMPOSITION_DECODE_RULE(rule_code, gref, nref) \ - do { \ - gref = (rule_code) / 12; \ - if (gref > 12) gref = 11; \ - nref = (rule_code) % 12; \ + reference point code), NREF (new reference point code), XOFF + (horizontal offset) YOFF (vertical offset). Don't check RULE_CODE, + always set GREF and NREF to valid values. By side effect, + RULE_CODE is modified. */ + +#define COMPOSITION_DECODE_RULE(rule_code, gref, nref, xoff, yoff) \ + do { \ + xoff = (rule_code) >> 16; \ + yoff = ((rule_code) >> 8) & 0xFF; \ + rule_code &= 0xFF; \ + gref = (rule_code) / 12; \ + if (gref > 12) gref = 11; \ + nref = (rule_code) % 12; \ } while (0) /* Return encoded composition rule for the pair of global reference @@ -161,6 +174,8 @@ struct composition { /* Width, ascent, and descent pixels of the composition. */ short pixel_width, ascent, descent; + short lbearing, rbearing; + /* How many columns the overall glyphs occupy on the screen. This gives an approximate value for column calculation in Fcurrent_column, and etc. */ @@ -200,11 +215,14 @@ extern int n_compositions; extern Lisp_Object Qcomposition; extern Lisp_Object composition_hash_table; +extern Lisp_Object Qauto_composed; +extern Lisp_Object Vauto_composition_function; +extern Lisp_Object Qauto_composition_function; extern int get_composition_id P_ ((int, int, int, Lisp_Object, Lisp_Object)); -extern int find_composition P_ ((int, int, int *, int *, Lisp_Object *, +extern int find_composition P_ ((int, int, EMACS_INT *, EMACS_INT *, Lisp_Object *, Lisp_Object)); -extern void update_compositions P_ ((int, int, int)); +extern void update_compositions P_ ((EMACS_INT, EMACS_INT, int)); extern void make_composition_value_copy P_ ((Lisp_Object)); extern void compose_region P_ ((int, int, Lisp_Object, Lisp_Object, Lisp_Object)); diff --git a/src/config.in b/src/config.in index ac78c53a4b6..d7023aafa70 100644 --- a/src/config.in +++ b/src/config.in @@ -159,6 +159,9 @@ Boston, MA 02110-1301, USA. */ /* Define to 1 if you have the `fpathconf' function. */ #undef HAVE_FPATHCONF +/* Define to 1 if you have freetype and fontconfig libraries. */ +#undef HAVE_FREETYPE + /* Define to 1 if you have the `frexp' function. */ #undef HAVE_FREXP @@ -349,6 +352,9 @@ Boston, MA 02110-1301, USA. */ /* Define to 1 if you have the `ncurses' library (-lncurses). */ #undef HAVE_LIBNCURSES +/* Define to 1 if you have libotf library. */ +#undef HAVE_LIBOTF + /* Define to 1 if you have the <libpng/png.h> header file. */ #undef HAVE_LIBPNG_PNG_H @@ -385,6 +391,9 @@ Boston, MA 02110-1301, USA. */ /* Define to 1 if you have the `lrand48' function. */ #undef HAVE_LRAND48 +/* Define to 1 if you have m17n-flt library. */ +#undef HAVE_M17N_FLT + /* Define to 1 if you have the <machine/soundcard.h> header file. */ #undef HAVE_MACHINE_SOUNDCARD_H @@ -847,6 +856,9 @@ Boston, MA 02110-1301, USA. */ /* Define to the unexec source file name. */ #undef UNEXEC_SRC +/* Define to 1 if we should use font-backend. */ +#undef USE_FONT_BACKEND + /* Define to 1 if we should use toolkit scroll bars. */ #undef USE_TOOLKIT_SCROLL_BARS diff --git a/src/data.c b/src/data.c index 0e3987ae540..88a665b3cf8 100644 --- a/src/data.c +++ b/src/data.c @@ -25,7 +25,7 @@ Boston, MA 02110-1301, USA. */ #include <stdio.h> #include "lisp.h" #include "puresize.h" -#include "charset.h" +#include "character.h" #include "buffer.h" #include "keyboard.h" #include "frame.h" @@ -116,7 +116,7 @@ wrong_type_argument (predicate, value) { /* If VALUE is not even a valid Lisp object, abort here where we can get a backtrace showing where it came from. */ - if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) + if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit) abort (); xsignal2 (Qwrong_type_argument, predicate, value); @@ -188,7 +188,7 @@ for example, (type-of 1) returns `integer'. */) (object) Lisp_Object object; { - switch (XGCTYPE (object)) + switch (XTYPE (object)) { case Lisp_Int: return Qinteger; @@ -215,25 +215,25 @@ for example, (type-of 1) returns `integer'. */) abort (); case Lisp_Vectorlike: - if (GC_WINDOW_CONFIGURATIONP (object)) + if (WINDOW_CONFIGURATIONP (object)) return Qwindow_configuration; - if (GC_PROCESSP (object)) + if (PROCESSP (object)) return Qprocess; - if (GC_WINDOWP (object)) + if (WINDOWP (object)) return Qwindow; - if (GC_SUBRP (object)) + if (SUBRP (object)) return Qsubr; - if (GC_COMPILEDP (object)) + if (COMPILEDP (object)) return Qcompiled_function; - if (GC_BUFFERP (object)) + if (BUFFERP (object)) return Qbuffer; - if (GC_CHAR_TABLE_P (object)) + if (CHAR_TABLE_P (object)) return Qchar_table; - if (GC_BOOL_VECTOR_P (object)) + if (BOOL_VECTOR_P (object)) return Qbool_vector; - if (GC_FRAMEP (object)) + if (FRAMEP (object)) return Qframe; - if (GC_HASH_TABLE_P (object)) + if (HASH_TABLE_P (object)) return Qhash_table; return Qvector; @@ -436,11 +436,11 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p, } DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, - doc: /* Return t if OBJECT is a character (an integer) or a string. */) + doc: /* Return t if OBJECT is a character or a string. */) (object) register Lisp_Object object; { - if (INTEGERP (object) || STRINGP (object)) + if (CHARACTERP (object) || STRINGP (object)) return Qt; return Qnil; } @@ -1989,96 +1989,8 @@ or a byte-code object. IDX starts at 0. */) } else if (CHAR_TABLE_P (array)) { - Lisp_Object val; - - val = Qnil; - - if (idxval < 0) - args_out_of_range (array, idx); - if (idxval < CHAR_TABLE_ORDINARY_SLOTS) - { - if (! SINGLE_BYTE_CHAR_P (idxval)) - args_out_of_range (array, idx); - /* For ASCII and 8-bit European characters, the element is - stored in the top table. */ - val = XCHAR_TABLE (array)->contents[idxval]; - if (NILP (val)) - { - int default_slot - = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII - : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL - : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); - val = XCHAR_TABLE (array)->contents[default_slot]; - } - if (NILP (val)) - val = XCHAR_TABLE (array)->defalt; - while (NILP (val)) /* Follow parents until we find some value. */ - { - array = XCHAR_TABLE (array)->parent; - if (NILP (array)) - return Qnil; - val = XCHAR_TABLE (array)->contents[idxval]; - if (NILP (val)) - val = XCHAR_TABLE (array)->defalt; - } - return val; - } - else - { - int code[4], i; - Lisp_Object sub_table; - Lisp_Object current_default; - - SPLIT_CHAR (idxval, code[0], code[1], code[2]); - if (code[1] < 32) code[1] = -1; - else if (code[2] < 32) code[2] = -1; - - /* Here, the possible range of CODE[0] (== charset ID) is - 128..MAX_CHARSET. Since the top level char table contains - data for multibyte characters after 256th element, we must - increment CODE[0] by 128 to get a correct index. */ - code[0] += 128; - code[3] = -1; /* anchor */ - - try_parent_char_table: - current_default = XCHAR_TABLE (array)->defalt; - sub_table = array; - for (i = 0; code[i] >= 0; i++) - { - val = XCHAR_TABLE (sub_table)->contents[code[i]]; - if (SUB_CHAR_TABLE_P (val)) - { - sub_table = val; - if (! NILP (XCHAR_TABLE (sub_table)->defalt)) - current_default = XCHAR_TABLE (sub_table)->defalt; - } - else - { - if (NILP (val)) - val = current_default; - if (NILP (val)) - { - array = XCHAR_TABLE (array)->parent; - if (!NILP (array)) - goto try_parent_char_table; - } - return val; - } - } - /* Reaching here means IDXVAL is a generic character in - which each character or a group has independent value. - Essentially it's nonsense to get a value for such a - generic character, but for backward compatibility, we try - the default value and parent. */ - val = current_default; - if (NILP (val)) - { - array = XCHAR_TABLE (array)->parent; - if (!NILP (array)) - goto try_parent_char_table; - } - return val; - } + CHECK_CHARACTER (idx); + return CHAR_TABLE_REF (array, idxval); } else { @@ -2134,45 +2046,8 @@ bool-vector. IDX starts at 0. */) } else if (CHAR_TABLE_P (array)) { - if (idxval < 0) - args_out_of_range (array, idx); - if (idxval < CHAR_TABLE_ORDINARY_SLOTS) - { - if (! SINGLE_BYTE_CHAR_P (idxval)) - args_out_of_range (array, idx); - XCHAR_TABLE (array)->contents[idxval] = newelt; - } - else - { - int code[4], i; - Lisp_Object val; - - SPLIT_CHAR (idxval, code[0], code[1], code[2]); - if (code[1] < 32) code[1] = -1; - else if (code[2] < 32) code[2] = -1; - - /* See the comment of the corresponding part in Faref. */ - code[0] += 128; - code[3] = -1; /* anchor */ - for (i = 0; code[i + 1] >= 0; i++) - { - val = XCHAR_TABLE (array)->contents[code[i]]; - if (SUB_CHAR_TABLE_P (val)) - array = val; - else - { - Lisp_Object temp; - - /* VAL is a leaf. Create a sub char table with the - initial value VAL and look into it. */ - - temp = make_sub_char_table (val); - XCHAR_TABLE (array)->contents[code[i]] = temp; - array = temp; - } - } - XCHAR_TABLE (array)->contents[code[i]] = newelt; - } + CHECK_CHARACTER (idx); + CHAR_TABLE_SET (array, idxval, newelt); } else if (STRING_MULTIBYTE (array)) { @@ -2181,7 +2056,7 @@ bool-vector. IDX starts at 0. */) if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); - CHECK_NUMBER (newelt); + CHECK_CHARACTER (newelt); nbytes = SBYTES (array); @@ -2216,38 +2091,9 @@ bool-vector. IDX starts at 0. */) args_out_of_range (array, idx); CHECK_NUMBER (newelt); - if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt))) - SSET (array, idxval, XINT (newelt)); - else - { - /* We must relocate the string data while converting it to - multibyte. */ - int idxval_byte, prev_bytes, new_bytes; - unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; - unsigned char *origstr = SDATA (array), *str; - int nchars, nbytes; - USE_SAFE_ALLOCA; - - nchars = SCHARS (array); - nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval); - nbytes += count_size_as_multibyte (origstr + idxval, - nchars - idxval); - SAFE_ALLOCA (str, unsigned char *, nbytes); - copy_text (SDATA (array), str, nchars, 0, 1); - PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte, - prev_bytes); - new_bytes = CHAR_STRING (XINT (newelt), p0); - allocate_string_data (XSTRING (array), nchars, - nbytes + new_bytes - prev_bytes); - bcopy (str, SDATA (array), idxval_byte); - p1 = SDATA (array) + idxval_byte; - while (new_bytes--) - *p1++ = *p0++; - bcopy (str + idxval_byte + prev_bytes, p1, - nbytes - (idxval_byte + prev_bytes)); - SAFE_FREE (); - clear_string_char_byte_cache (); - } + if (XINT (newelt) >= 0 && ! SINGLE_BYTE_CHAR_P (XINT (newelt))) + args_out_of_range (array, newelt); + SSET (array, idxval, XINT (newelt)); } return newelt; diff --git a/src/dired.c b/src/dired.c index 09c72f69fdf..ccd27dbb713 100644 --- a/src/dired.c +++ b/src/dired.c @@ -96,6 +96,7 @@ extern struct direct *readdir (); #include "systime.h" #include "buffer.h" #include "commands.h" +#include "character.h" #include "charset.h" #include "coding.h" #include "regex.h" diff --git a/src/dispextern.h b/src/dispextern.h index 9cf666b2fd2..b8027593721 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -852,6 +852,12 @@ struct glyph_row /* Continuation lines width at the start of the row. */ int continuation_lines_width; + +#ifdef HAVE_WINDOW_SYSTEM + /* Non-NULL means the current clipping area. This is temporarily + set while exposing a region. Coordinates are frame-relative. */ + XRectangle *clip; +#endif }; @@ -1215,6 +1221,12 @@ struct glyph_string *clip_tail, not including their overhangs. */ struct glyph_string *clip_head, *clip_tail; + /* The current clipping areas. */ + NativeRectangle clip[2]; + + /* Number of clipping areas. */ + int num_clips; + struct glyph_string *next, *prev; }; @@ -1386,6 +1398,7 @@ enum lface_attribute_index LFACE_FONT_INDEX, LFACE_INHERIT_INDEX, LFACE_AVGWIDTH_INDEX, + LFACE_FONTSET_INDEX, LFACE_VECTOR_SIZE }; @@ -1470,10 +1483,10 @@ struct face reallocated. */ int font_info_id; - /* Fontset ID if this face uses a fontset, or -1. This is only >= 0 - if the face was realized for a composition sequence. - Otherwise, a specific font is loaded from the set of fonts - specified by the fontset given by the family attribute of the face. */ + struct font_info *font_info; + + /* Fontset ID if for this face's fontset. Non-ASCII faces derived + from the same ASCII face have the same fontset. */ int fontset; /* Pixmap width and height. */ @@ -1505,13 +1518,6 @@ struct face /* The hash value of this face. */ unsigned hash; - /* The charset for which this face was realized if it was realized - for use in multibyte text. If fontset >= 0, this is the charset - of the first character of the composition sequence. A value of - charset < 0 means the face was realized for use in unibyte text - where the idea of Emacs charsets isn't applicable. */ - int charset; - /* Non-zero if text in this face should be underlined, overlined, strike-through or have a box drawn around it. */ unsigned underline_p : 1; @@ -1557,9 +1563,13 @@ struct face /* Next and previous face in hash collision list of face cache. */ struct face *next, *prev; - /* If this face is for ASCII characters, this points this face - itself. Otherwise, this points a face for ASCII characters. */ + /* If this face is an ASCII face, this points to this face itself. + Otherwise, this points to an ASCII face that has the same + attributes except the font. */ struct face *ascii_face; + + /* Extra member that a font-driver uses privately. */ + void *extra; }; @@ -1647,7 +1657,7 @@ struct face_cache /* Non-zero if FACE is suitable for displaying character CHAR. */ #define FACE_SUITABLE_FOR_CHAR_P(FACE, CHAR) \ - (SINGLE_BYTE_CHAR_P (CHAR) \ + (ASCII_CHAR_P (CHAR) \ ? (FACE) == (FACE)->ascii_face \ : face_suitable_for_char_p ((FACE), (CHAR))) @@ -1655,15 +1665,15 @@ struct face_cache with id ID but is suitable for displaying character CHAR. This macro is only meaningful for multibyte character CHAR. */ -#define FACE_FOR_CHAR(F, FACE, CHAR) \ - (SINGLE_BYTE_CHAR_P (CHAR) \ - ? (FACE)->ascii_face->id \ - : face_for_char ((F), (FACE), (CHAR))) +#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) \ + (ASCII_CHAR_P (CHAR) \ + ? (FACE)->ascii_face->id \ + : face_for_char ((F), (FACE), (CHAR), (POS), (OBJECT))) #else /* not HAVE_WINDOW_SYSTEM */ #define FACE_SUITABLE_FOR_CHAR_P(FACE, CHAR) 1 -#define FACE_FOR_CHAR(F, FACE, CHAR) ((FACE)->id) +#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) ((FACE)->id) #endif /* not HAVE_WINDOW_SYSTEM */ @@ -1781,6 +1791,7 @@ enum display_element_type enum prop_idx { + AUTO_COMPOSED_PROP_IDX, FONTIFIED_PROP_IDX, FACE_PROP_IDX, INVISIBLE_PROP_IDX, @@ -2333,7 +2344,9 @@ struct redisplay_interface the two-byte form of C. Encoding is returned in *CHAR2B. If TWO_BYTE_P is non-null, return non-zero there if font is two-byte. */ int (*encode_char) P_ ((int c, XChar2b *char2b, - struct font_info *font_into, int *two_byte_p)); + struct font_info *font_into, + struct charset *charset, + int *two_byte_p)); /* Compute left and right overhang of glyph string S. A NULL pointer if platform does not support this. */ @@ -2842,15 +2855,17 @@ void clear_face_cache P_ ((int)); unsigned long load_color P_ ((struct frame *, struct face *, Lisp_Object, enum lface_attribute_index)); void unload_color P_ ((struct frame *, unsigned long)); -int face_font_available_p P_ ((struct frame *, Lisp_Object)); +char *choose_face_font P_ ((struct frame *, Lisp_Object *, Lisp_Object, + int *)); int ascii_face_of_lisp_face P_ ((struct frame *, int)); void prepare_face_for_display P_ ((struct frame *, struct face *)); int xstricmp P_ ((const unsigned char *, const unsigned char *)); -int lookup_face P_ ((struct frame *, Lisp_Object *, int, struct face *)); -int lookup_named_face P_ ((struct frame *, Lisp_Object, int, int)); +int lookup_face P_ ((struct frame *, Lisp_Object *)); +int lookup_non_ascii_face P_ ((struct frame *, int, struct face *)); +int lookup_named_face P_ ((struct frame *, Lisp_Object, int)); int smaller_face P_ ((struct frame *, int, int)); int face_with_height P_ ((struct frame *, int, int)); -int lookup_derived_face P_ ((struct frame *, Lisp_Object, int, int, int)); +int lookup_derived_face P_ ((struct frame *, Lisp_Object, int, int)); void init_frame_faces P_ ((struct frame *)); void free_frame_faces P_ ((struct frame *)); void recompute_basic_faces P_ ((struct frame *)); @@ -2864,10 +2879,12 @@ int face_at_string_position P_ ((struct window *, Lisp_Object, int, int, int, int merge_faces P_ ((struct frame *, Lisp_Object, int, int)); int compute_char_face P_ ((struct frame *, int, Lisp_Object)); void free_all_realized_faces P_ ((Lisp_Object)); +void free_realized_face P_ ((struct frame *, struct face *)); extern Lisp_Object Qforeground_color, Qbackground_color; extern Lisp_Object Qframe_set_background_mode; extern char unspecified_fg[], unspecified_bg[]; -void free_realized_multibyte_face P_ ((struct frame *, int)); +extern Lisp_Object split_font_name_into_vector P_ ((Lisp_Object)); +extern Lisp_Object build_font_name_from_vector P_ ((Lisp_Object)); /* Defined in xfns.c */ diff --git a/src/dispnew.c b/src/dispnew.c index 312ec38f445..d7bca7acbc4 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -36,7 +36,7 @@ Boston, MA 02110-1301, USA. */ #include "dispextern.h" #include "cm.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "keyboard.h" #include "frame.h" #include "termhooks.h" diff --git a/src/disptab.h b/src/disptab.h index 19033dc993e..3efb47d26a0 100644 --- a/src/disptab.h +++ b/src/disptab.h @@ -36,8 +36,14 @@ Boston, MA 02110-1301, USA. */ extern Lisp_Object disp_char_vector P_ ((struct Lisp_Char_Table *, int)); -#define DISP_CHAR_VECTOR(dp, c) \ - (SINGLE_BYTE_CHAR_P(c) ? (dp)->contents[c] : disp_char_vector ((dp), (c))) +#define DISP_CHAR_VECTOR(dp, c) \ + (ASCII_CHAR_P(c) \ + ? (NILP ((dp)->ascii) \ + ? (dp)->defalt \ + : (SUB_CHAR_TABLE_P ((dp)->ascii) \ + ? XSUB_CHAR_TABLE ((dp)->ascii)->contents[c] \ + : (dp)->ascii)) \ + : disp_char_vector ((dp), (c))) /* Defined in window.c. */ extern struct Lisp_Char_Table *window_display_table P_ ((struct window *)); diff --git a/src/doc.c b/src/doc.c index ec02449035a..5dc30a01053 100644 --- a/src/doc.c +++ b/src/doc.c @@ -41,7 +41,7 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "buffer.h" #include "keyboard.h" -#include "charset.h" +#include "character.h" #include "keymap.h" #ifdef HAVE_INDEX diff --git a/src/doprnt.c b/src/doprnt.c index e9c97d60ccc..d049ec2d060 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -47,7 +47,7 @@ Boston, MA 02110-1301, USA. */ /* Since we use the macro CHAR_HEAD_P, we have to include this, but don't have to include others because CHAR_HEAD_P does not contains another macro. */ -#include "charset.h" +#include "character.h" static int doprnt1 (); diff --git a/src/dosfns.c b/src/dosfns.c index 32d7a2c8d74..2d2d4e04e7d 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -38,7 +38,7 @@ Boston, MA 02110-1301, USA. */ #include "dosfns.h" #include "msdos.h" #include "dispextern.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include <dpmi.h> #include <go32.h> diff --git a/src/editfns.c b/src/editfns.c index f5b71f2aa18..fa1b229bfc4 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -52,7 +52,7 @@ Boston, MA 02110-1301, USA. */ #include "intervals.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "frame.h" #include "window.h" @@ -210,11 +210,9 @@ usage: (char-to-string CHAR) */) int len; unsigned char str[MAX_MULTIBYTE_LENGTH]; - CHECK_NUMBER (character); + CHECK_CHARACTER (character); - len = (SINGLE_BYTE_CHAR_P (XFASTINT (character)) - ? (*str = (unsigned char)(XFASTINT (character)), 1) - : char_to_string (XFASTINT (character), str)); + len = CHAR_STRING (XFASTINT (character), str); return make_string_from_bytes (str, 1, len); } @@ -2155,7 +2153,7 @@ general_insert_function (insert_func, insert_from_string_func, for (argnum = 0; argnum < nargs; argnum++) { val = args[argnum]; - if (INTEGERP (val)) + if (CHARACTERP (val)) { unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; @@ -2164,7 +2162,7 @@ general_insert_function (insert_func, insert_from_string_func, len = CHAR_STRING (XFASTINT (val), str); else { - str[0] = (SINGLE_BYTE_CHAR_P (XINT (val)) + str[0] = (ASCII_CHAR_P (XINT (val)) ? XINT (val) : multibyte_char_to_unibyte (XINT (val), Qnil)); len = 1; @@ -2331,6 +2329,29 @@ from adjoining text, if those properties are sticky. */) return Qnil; } +DEFUN ("insert-byte", Finsert_byte, Sinsert_byte, 2, 3, 0, + doc: /* Insert COUNT (second arg) copies of BYTE (first arg). +Both arguments are required. +BYTE is a number of the range 0..255. + +If BYTE is 128..255 and the current buffer is multibyte, the +corresponding eight-bit character is inserted. + +Point, and before-insertion markers, are relocated as in the function `insert'. +The optional third arg INHERIT, if non-nil, says to inherit text properties +from adjoining text, if those properties are sticky. */) + (byte, count, inherit) + Lisp_Object byte, count, inherit; +{ + CHECK_NUMBER (byte); + if (XINT (byte) < 0 || XINT (byte) > 255) + args_out_of_range_3 (byte, make_number (0), make_number (255)); + if (XINT (byte) >= 128 + && ! NILP (current_buffer->enable_multibyte_characters)) + XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); + return Finsert_char (byte, count, inherit); +} + /* Making strings from buffer contents. */ @@ -2892,12 +2913,73 @@ Both characters must have the same length of multi-byte form. */) return Qnil; } + +static Lisp_Object check_translation P_ ((int, int, int, Lisp_Object)); + +/* Helper function for Ftranslate_region_internal. + + Check if a character sequence at POS (POS_BYTE) matches an element + of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching + element is found, return it. Otherwise return Qnil. */ + +static Lisp_Object +check_translation (pos, pos_byte, end, val) + int pos, pos_byte, end; + Lisp_Object val; +{ + int buf_size = 16, buf_used = 0; + int *buf = alloca (sizeof (int) * buf_size); + + for (; CONSP (val); val = XCDR (val)) + { + Lisp_Object elt; + int len, i; + + elt = XCAR (val); + if (! CONSP (elt)) + continue; + elt = XCAR (elt); + if (! VECTORP (elt)) + continue; + len = ASIZE (elt); + if (len <= end - pos) + { + for (i = 0; i < len; i++) + { + if (buf_used <= i) + { + unsigned char *p = BYTE_POS_ADDR (pos_byte); + int len; + + if (buf_used == buf_size) + { + int *newbuf; + + buf_size += 16; + newbuf = alloca (sizeof (int) * buf_size); + memcpy (newbuf, buf, sizeof (int) * buf_used); + buf = newbuf; + } + buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, 0, len); + pos_byte += len; + } + if (XINT (AREF (elt, i)) != buf[i]) + break; + } + if (i == len) + return XCAR (val); + } + } + return Qnil; +} + + DEFUN ("translate-region-internal", Ftranslate_region_internal, Stranslate_region_internal, 3, 3, 0, doc: /* Internal use only. From START to END, translate characters according to TABLE. -TABLE is a string; the Nth character in it is the mapping -for the character with code N. +TABLE is a string or a char-table; the Nth character in it is the +mapping for the character with code N. It returns the number of characters changed. */) (start, end, table) Lisp_Object start; @@ -2911,10 +2993,13 @@ It returns the number of characters changed. */) int pos, pos_byte, end_pos; int multibyte = !NILP (current_buffer->enable_multibyte_characters); int string_multibyte; + Lisp_Object val; validate_region (&start, &end); if (CHAR_TABLE_P (table)) { + if (! EQ (XCHAR_TABLE (table)->purpose, Qtranslation_table)) + error ("Not a translation table"); size = MAX_CHAR; tt = NULL; } @@ -2925,14 +3010,14 @@ It returns the number of characters changed. */) if (! multibyte && (SCHARS (table) < SBYTES (table))) table = string_make_unibyte (table); string_multibyte = SCHARS (table) < SBYTES (table); - size = SCHARS (table); + size = SBYTES (table); tt = SDATA (table); } pos = XINT (start); pos_byte = CHAR_TO_BYTE (pos); end_pos = XINT (end); - modify_region (current_buffer, pos, XINT (end), 0); + modify_region (current_buffer, pos, end_pos, 0); cnt = 0; for (; pos < end_pos; ) @@ -2941,6 +3026,7 @@ It returns the number of characters changed. */) unsigned char *str, buf[MAX_MULTIBYTE_LENGTH]; int len, str_len; int oc; + Lisp_Object val; if (multibyte) oc = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len); @@ -2955,7 +3041,7 @@ It returns the number of characters changed. */) if (string_multibyte) { str = tt + string_char_to_byte (table, oc); - nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, + nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, str_len); } else @@ -2963,7 +3049,7 @@ It returns the number of characters changed. */) nc = tt[oc]; if (! ASCII_BYTE_P (nc) && multibyte) { - str_len = CHAR_STRING (nc, buf); + str_len = BYTE8_STRING (nc, buf); str = buf; } else @@ -2975,28 +3061,34 @@ It returns the number of characters changed. */) } else { - Lisp_Object val; int c; nc = oc; val = CHAR_TABLE_REF (table, oc); - if (INTEGERP (val) + if (CHARACTERP (val) && (c = XINT (val), CHAR_VALID_P (c, 0))) { nc = c; str_len = CHAR_STRING (nc, buf); str = buf; } + else if (VECTORP (val) || (CONSP (val))) + { + /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...) + where TO is TO-CHAR or [TO-CHAR ...]. */ + nc = -1; + } } - if (nc != oc) + if (nc != oc && nc >= 0) { + /* Simple one char to one char translation. */ if (len != str_len) { Lisp_Object string; /* This is less efficient, because it moves the gap, - but it should multibyte characters correctly. */ + but it should handle multibyte characters correctly. */ string = make_multibyte_string (str, 1, str_len); replace_range (pos, pos + 1, string, 1, 0, 1); len = str_len; @@ -3011,6 +3103,46 @@ It returns the number of characters changed. */) } ++cnt; } + else if (nc < 0) + { + Lisp_Object string; + + if (CONSP (val)) + { + val = check_translation (pos, pos_byte, end_pos, val); + if (NILP (val)) + { + pos_byte += len; + pos++; + continue; + } + /* VAL is ([FROM-CHAR ...] . TO). */ + len = ASIZE (XCAR (val)); + val = XCDR (val); + } + else + len = 1; + + if (VECTORP (val)) + { + int i; + + string = Fmake_string (make_number (ASIZE (val)), + AREF (val, 0)); + for (i = 1; i < ASIZE (val); i++) + Faset (string, make_number (i), AREF (val, i)); + } + else + { + string = Fmake_string (make_number (1), val); + } + replace_range (pos, pos + len, string, 1, 0, 1); + pos_byte += SBYTES (string); + pos += SCHARS (string); + cnt += SCHARS (string); + end_pos += SCHARS (string) - len; + continue; + } } pos_byte += len; pos++; @@ -3608,8 +3740,8 @@ usage: (format STRING &rest OBJECTS) */) thissize = 30 + (precision[n] > 0 ? precision[n] : 0); if (*format == 'c') { - if (! SINGLE_BYTE_CHAR_P (XINT (args[n])) - /* Note: No one can remember why we have to treat + if (! ASCII_CHAR_P (XINT (args[n])) + /* Note: No one can remeber why we have to treat the character 0 as a multibyte character here. But, until it causes a real problem, let's don't change it. */ @@ -4030,8 +4162,20 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer. */) /* Do these in separate statements, then compare the variables. because of the way DOWNCASE uses temp variables. */ - i1 = DOWNCASE (XFASTINT (c1)); - i2 = DOWNCASE (XFASTINT (c2)); + i1 = XFASTINT (c1); + if (NILP (current_buffer->enable_multibyte_characters) + && ! ASCII_CHAR_P (i1)) + { + MAKE_CHAR_MULTIBYTE (i1); + } + i2 = XFASTINT (c2); + if (NILP (current_buffer->enable_multibyte_characters) + && ! ASCII_CHAR_P (i2)) + { + MAKE_CHAR_MULTIBYTE (i2); + } + i1 = DOWNCASE (i1); + i2 = DOWNCASE (i2); return (i1 == i2 ? Qt : Qnil); } @@ -4526,6 +4670,7 @@ functions if all the text being accessed has this property. */); defsubr (&Sinsert_and_inherit); defsubr (&Sinsert_and_inherit_before_markers); defsubr (&Sinsert_char); + defsubr (&Sinsert_byte); defsubr (&Suser_login_name); defsubr (&Suser_real_login_name); diff --git a/src/emacs.c b/src/emacs.c index 85aa2f3a6f7..21e583f7d91 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -788,6 +788,9 @@ bug_reporting_address () return count >= 3 ? REPORT_EMACS_BUG_PRETEST_ADDRESS : REPORT_EMACS_BUG_ADDRESS; } +#ifdef USE_FONT_BACKEND +extern int enable_font_backend; +#endif /* USE_FONT_BACKEND */ /* ARGSUSED */ int @@ -1282,6 +1285,7 @@ main (argc, argv init_alloc_once (); init_obarray (); init_eval_once (); + init_character_once (); init_charset_once (); init_coding_once (); init_syntax_once (); /* Create standard syntax table. */ @@ -1320,7 +1324,6 @@ main (argc, argv syms_of_macterm (); syms_of_macmenu (); syms_of_macselect (); - syms_of_data (); syms_of_search (); syms_of_frame (); @@ -1328,6 +1331,16 @@ main (argc, argv mac_term_init (build_string ("Mac"), NULL, NULL); init_keyboard (); #endif + /* Called before syms_of_fileio, because it sets up Qerror_condition. */ + syms_of_data (); + syms_of_fileio (); + /* Before syms_of_coding to initialize Vgc_cons_threshold. */ + syms_of_alloc (); + /* Before syms_of_coding because it initializes Qcharsetp. */ + syms_of_charset (); + /* Before init_window_once, because it sets up the + Vcoding_system_hash_table. */ + syms_of_coding (); /* This should be after syms_of_fileio. */ init_window_once (); /* Init the window system. */ init_fileio_once (); /* Must precede any path manipulation. */ @@ -1403,12 +1416,15 @@ main (argc, argv Lisp_Object buffer; buffer = Fcdr (XCAR (tail)); - /* Verify that all buffers are empty now, as they - ought to be. */ - if (BUF_Z (XBUFFER (buffer)) > BUF_BEG (XBUFFER (buffer))) - abort (); - /* It is safe to do this crudely in an empty buffer. */ - XBUFFER (buffer)->enable_multibyte_characters = Qnil; + /* Make a multibyte buffer unibyte. */ + if (BUF_Z_BYTE (XBUFFER (buffer)) > BUF_Z (XBUFFER (buffer))) + { + struct buffer *current = current_buffer; + + set_buffer_temp (XBUFFER (buffer)); + Fset_buffer_multibyte (Qnil); + set_buffer_temp (current); + } } } } @@ -1416,6 +1432,16 @@ main (argc, argv no_loadup = argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args); +#ifdef USE_FONT_BACKEND + enable_font_backend = 1; + if (argmatch (argv, argc, "-enable-font-backend", "--enable-font-backend", + 4, NULL, &skip_args)) + enable_font_backend = 1; + else if (argmatch (argv, argc, + "-disable-font-backend", "--disable-font-backend", + 4, NULL, &skip_args)) + enable_font_backend = 0; +#endif /* USE_FONT_BACKEND */ #ifdef HAVE_X_WINDOWS /* Stupid kludge to catch command-line display spec. We can't @@ -1536,7 +1562,7 @@ main (argc, argv /* Called before init_window_once for Mac OS Classic. */ syms_of_data (); #endif - syms_of_alloc (); + syms_of_chartab (); syms_of_lread (); syms_of_print (); syms_of_eval (); @@ -1554,7 +1580,7 @@ main (argc, argv /* Called before init_window_once for Mac OS Classic. */ syms_of_ccl (); #endif - syms_of_charset (); + syms_of_character (); syms_of_cmds (); #ifndef NO_DIR_LIBRARY syms_of_dired (); @@ -1563,8 +1589,6 @@ main (argc, argv syms_of_doc (); syms_of_editfns (); syms_of_emacs (); - syms_of_fileio (); - syms_of_coding (); /* This should be after syms_of_fileio. */ #ifdef CLASH_DETECTION syms_of_filelock (); #endif /* CLASH_DETECTION */ @@ -1601,6 +1625,7 @@ main (argc, argv syms_of_window (); syms_of_xdisp (); #ifdef HAVE_WINDOW_SYSTEM + syms_of_font (); syms_of_fringe (); syms_of_image (); #endif /* HAVE_WINDOW_SYSTEM */ @@ -1670,6 +1695,8 @@ main (argc, argv #endif /* HAVE_NTGUI */ } + init_charset (); + init_editfns (); /* init_process uses Voperating_system_release. */ init_process (); /* init_display uses add_keyboard_wait_descriptor. */ #ifndef MAC_OS8 @@ -1816,6 +1843,8 @@ struct standard_args standard_args[] = { "-unibyte", "--unibyte", 81, 0 }, { "-no-multibyte", "--no-multibyte", 80, 0 }, { "-nl", "--no-loadup", 70, 0 }, + { "-enable-font-backend", "--enable-font-backend", 65, 0 }, + { "-disable-font-backend", "--disable-font-backend", 65, 0 }, /* -d must come last before the options handled in startup.el. */ { "-d", "--display", 60, 1 }, { "-display", 0, 60, 1 }, diff --git a/src/fileio.c b/src/fileio.c index 19558fa332a..4dfb0d24796 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -75,7 +75,7 @@ extern int errno; #include "lisp.h" #include "intervals.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "window.h" #include "blockinput.h" @@ -274,9 +274,12 @@ report_file_error (string, data) { Lisp_Object errstring; int errorno = errno; + char *str; synchronize_system_messages_locale (); - errstring = code_convert_string_norecord (build_string (strerror (errorno)), + str = strerror (errorno); + errstring = code_convert_string_norecord (make_unibyte_string (str, + strlen (str)), Vlocale_coding_system, 0); while (1) @@ -314,6 +317,7 @@ restore_point_unwind (location) Fset_marker (location, Qnil, Qnil); return Qnil; } + Lisp_Object Qexpand_file_name; Lisp_Object Qsubstitute_in_file_name; @@ -1142,8 +1146,19 @@ See also the function `substitute-in-file-name'. */) } name = FILE_SYSTEM_CASE (name); - nm = SDATA (name); multibyte = STRING_MULTIBYTE (name); + if (multibyte != STRING_MULTIBYTE (default_directory)) + { + if (multibyte) + default_directory = string_to_multibyte (default_directory); + else + { + name = string_to_multibyte (name); + multibyte = 1; + } + } + + nm = SDATA (name); #ifdef DOS_NT /* We will force directory separators to be either all \ or /, so make @@ -1452,7 +1467,6 @@ See also the function `substitute-in-file-name'. */) && !newdir) { newdir = SDATA (default_directory); - multibyte |= STRING_MULTIBYTE (default_directory); #ifdef DOS_NT /* Note if special escape prefix is present, but remove for now. */ if (newdir[0] == '/' && newdir[1] == ':') @@ -2294,7 +2308,8 @@ duplicates what `expand-file-name' does. */) convert what we substitute into multibyte. */ while (*o) { - int c = unibyte_char_to_multibyte (*o++); + int c = *o++; + c = unibyte_char_to_multibyte (c); x += CHAR_STRING (c, x); } } @@ -3733,7 +3748,7 @@ variable `last-coding-system-used' to the coding system actually used. */) unsigned char buffer[1 << 14]; int replace_handled = 0; int set_coding_system = 0; - int coding_system_decided = 0; + Lisp_Object coding_system; int read_quit = 0; Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark; int we_locked_file = 0; @@ -3754,6 +3769,10 @@ variable `last-coding-system-used' to the coding system actually used. */) CHECK_STRING (filename); filename = Fexpand_file_name (filename, Qnil); + /* The value Qnil means that the coding system is not yet + decided. */ + coding_system = Qnil; + /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qinsert_file_contents); @@ -3877,27 +3896,18 @@ variable `last-coding-system-used' to the coding system actually used. */) if (EQ (Vcoding_system_for_read, Qauto_save_coding)) { - /* We use emacs-mule for auto saving... */ - setup_coding_system (Qemacs_mule, &coding); - /* ... but with the special flag to indicate to read in a - multibyte sequence for eight-bit-control char as is. */ - coding.flags = 1; - coding.src_multibyte = 0; - coding.dst_multibyte - = !NILP (current_buffer->enable_multibyte_characters); - coding.eol_type = CODING_EOL_LF; - coding_system_decided = 1; + coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix); + setup_coding_system (coding_system, &coding); + /* Ensure we set Vlast_coding_system_used. */ + set_coding_system = 1; } else if (BEG < Z) { /* Decide the coding system to use for reading the file now because we can't use an optimized method for handling `coding:' tag if the current buffer is not empty. */ - Lisp_Object val; - val = Qnil; - if (!NILP (Vcoding_system_for_read)) - val = Vcoding_system_for_read; + coding_system = Vcoding_system_for_read; else { /* Don't try looking inside a file for a coding system @@ -3953,8 +3963,8 @@ variable `last-coding-system-used' to the coding system actually used. */) insert_1_both (read_buf, nread, nread, 0, 0, 0); TEMP_SET_PT_BOTH (BEG, BEG_BYTE); - val = call2 (Vset_auto_coding_function, - filename, make_number (nread)); + coding_system = call2 (Vset_auto_coding_function, + filename, make_number (nread)); set_buffer_internal (prev); /* Discard the unwind protect for recovering the @@ -3968,34 +3978,33 @@ variable `last-coding-system-used' to the coding system actually used. */) } } - if (NILP (val)) + if (NILP (coding_system)) { /* If we have not yet decided a coding system, check file-coding-system-alist. */ - Lisp_Object args[6], coding_systems; + Lisp_Object args[6]; args[0] = Qinsert_file_contents, args[1] = orig_filename; args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace; - coding_systems = Ffind_operation_coding_system (6, args); - if (CONSP (coding_systems)) - val = XCAR (coding_systems); + coding_system = Ffind_operation_coding_system (6, args); + if (CONSP (coding_system)) + coding_system = XCAR (coding_system); } } - setup_coding_system (Fcheck_coding_system (val), &coding); - /* Ensure we set Vlast_coding_system_used. */ - set_coding_system = 1; + if (NILP (coding_system)) + coding_system = Qundecided; + else + CHECK_CODING_SYSTEM (coding_system); - if (NILP (current_buffer->enable_multibyte_characters) - && ! NILP (val)) + if (NILP (current_buffer->enable_multibyte_characters)) /* We must suppress all character code conversion except for end-of-line conversion. */ - setup_raw_text_coding_system (&coding); + coding_system = raw_text_coding_system (coding_system); - coding.src_multibyte = 0; - coding.dst_multibyte - = !NILP (current_buffer->enable_multibyte_characters); - coding_system_decided = 1; + setup_coding_system (coding_system, &coding); + /* Ensure we set Vlast_coding_system_used. */ + set_coding_system = 1; } /* If requested, replace the accessible part of the buffer @@ -4014,7 +4023,8 @@ variable `last-coding-system-used' to the coding system actually used. */) and let the following if-statement handle the replace job. */ if (!NILP (replace) && BEGV < ZV - && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK)) + && (NILP (coding_system) + || ! CODING_REQUIRE_DECODING (&coding))) { /* same_at_start and same_at_end count bytes, because file access counts bytes @@ -4049,21 +4059,15 @@ variable `last-coding-system-used' to the coding system actually used. */) else if (nread == 0) break; - if (coding.type == coding_type_undecided) - detect_coding (&coding, buffer, nread); - if (coding.common_flags & CODING_REQUIRE_DECODING_MASK) - /* We found that the file should be decoded somehow. - Let's give up here. */ + if (CODING_REQUIRE_DETECTION (&coding)) { - giveup_match_end = 1; - break; + coding_system = detect_coding_system (buffer, nread, nread, 1, 0, + coding_system); + setup_coding_system (coding_system, &coding); } - if (coding.eol_type == CODING_EOL_UNDECIDED) - detect_eol (&coding, buffer, nread); - if (coding.eol_type != CODING_EOL_UNDECIDED - && coding.eol_type != CODING_EOL_LF) - /* We found that the format of eol should be decoded. + if (CODING_REQUIRE_DECODING (&coding)) + /* We found that the file should be decoded somehow. Let's give up here. */ { giveup_match_end = 1; @@ -4208,124 +4212,108 @@ variable `last-coding-system-used' to the coding system actually used. */) { int same_at_start = BEGV_BYTE; int same_at_end = ZV_BYTE; + int same_at_start_charpos; + int inserted_chars; int overlap; int bufpos; - /* Make sure that the gap is large enough. */ - int bufsize = 2 * st.st_size; - unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize); + unsigned char *decoded; int temp; + int this_count = SPECPDL_INDEX (); + int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + Lisp_Object conversion_buffer; + + conversion_buffer = code_conversion_save (1, multibyte); /* First read the whole file, performing code conversion into CONVERSION_BUFFER. */ if (lseek (fd, XINT (beg), 0) < 0) - { - xfree (conversion_buffer); - report_file_error ("Setting file position", - Fcons (orig_filename, Qnil)); - } + report_file_error ("Setting file position", + Fcons (orig_filename, Qnil)); total = st.st_size; /* Total bytes in the file. */ how_much = 0; /* Bytes read from file so far. */ inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ unprocessed = 0; /* Bytes not processed in previous loop. */ + GCPRO1 (conversion_buffer); while (how_much < total) { + /* We read one bunch by one (READ_BUF_SIZE bytes) to allow + quitting while reading a huge while. */ /* try is reserved in some compilers (Microsoft C) */ int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed); - unsigned char *destination = read_buf + unprocessed; int this; /* Allow quitting out of the actual I/O. */ immediate_quit = 1; QUIT; - this = emacs_read (fd, destination, trytry); + this = emacs_read (fd, read_buf + unprocessed, trytry); immediate_quit = 0; - if (this < 0 || this + unprocessed == 0) + if (this <= 0) { - how_much = this; + if (this < 0) + how_much = this; break; } how_much += this; - if (CODING_MAY_REQUIRE_DECODING (&coding)) - { - int require, result; - - this += unprocessed; - - /* If we are using more space than estimated, - make CONVERSION_BUFFER bigger. */ - require = decoding_buffer_size (&coding, this); - if (inserted + require + 2 * (total - how_much) > bufsize) - { - bufsize = inserted + require + 2 * (total - how_much); - conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize); - } - - /* Convert this batch with results in CONVERSION_BUFFER. */ - if (how_much >= total) /* This is the last block. */ - coding.mode |= CODING_MODE_LAST_BLOCK; - if (coding.composing != COMPOSITION_DISABLED) - coding_allocate_composition_data (&coding, BEGV); - result = decode_coding (&coding, read_buf, - conversion_buffer + inserted, - this, bufsize - inserted); - - /* Save for next iteration whatever we didn't convert. */ - unprocessed = this - coding.consumed; - bcopy (read_buf + coding.consumed, read_buf, unprocessed); - if (!NILP (current_buffer->enable_multibyte_characters)) - this = coding.produced; - else - this = str_as_unibyte (conversion_buffer + inserted, - coding.produced); - } - - inserted += this; + BUF_SET_PT (XBUFFER (conversion_buffer), + BUF_Z (XBUFFER (conversion_buffer))); + decode_coding_c_string (&coding, read_buf, unprocessed + this, + conversion_buffer); + unprocessed = coding.carryover_bytes; + if (coding.carryover_bytes > 0) + bcopy (coding.carryover, read_buf, unprocessed); } + UNGCPRO; + emacs_close (fd); - /* At this point, INSERTED is how many characters (i.e. bytes) - are present in CONVERSION_BUFFER. - HOW_MUCH should equal TOTAL, - or should be <= 0 if we couldn't read the file. */ + /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0 + if we couldn't read the file. */ if (how_much < 0) + error ("IO error reading %s: %s", + SDATA (orig_filename), emacs_strerror (errno)); + + if (unprocessed > 0) { - xfree (conversion_buffer); - coding_free_composition_data (&coding); - error ("IO error reading %s: %s", - SDATA (orig_filename), emacs_strerror (errno)); + coding.mode |= CODING_MODE_LAST_BLOCK; + decode_coding_c_string (&coding, read_buf, unprocessed, + conversion_buffer); + coding.mode &= ~CODING_MODE_LAST_BLOCK; } - /* Compare the beginning of the converted file - with the buffer text. */ + decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer)); + inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer)) + - BUF_BEG_BYTE (XBUFFER (conversion_buffer))); + + /* Compare the beginning of the converted string with the buffer + text. */ bufpos = 0; while (bufpos < inserted && same_at_start < same_at_end - && FETCH_BYTE (same_at_start) == conversion_buffer[bufpos]) + && FETCH_BYTE (same_at_start) == decoded[bufpos]) same_at_start++, bufpos++; - /* If the file matches the buffer completely, + /* If the file matches the head of buffer completely, there's no need to replace anything. */ if (bufpos == inserted) { - xfree (conversion_buffer); - coding_free_composition_data (&coding); - emacs_close (fd); specpdl_ptr--; /* Truncate the buffer to the size of the file. */ del_range_byte (same_at_start, same_at_end, 0); inserted = 0; + + unbind_to (this_count, Qnil); goto handled; } - /* Extend the start of non-matching text area to multibyte - character boundary. */ + /* Extend the start of non-matching text area to the previous + multibyte character boundary. */ if (! NILP (current_buffer->enable_multibyte_characters)) while (same_at_start > BEGV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) @@ -4338,11 +4326,11 @@ variable `last-coding-system-used' to the coding system actually used. */) /* Compare with same_at_start to avoid counting some buffer text as matching both at the file's beginning and at the end. */ while (bufpos > 0 && same_at_end > same_at_start - && FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1]) + && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1]) same_at_end--, bufpos--; - /* Extend the end of non-matching text area to multibyte - character boundary. */ + /* Extend the end of non-matching text area to the next + multibyte character boundary. */ if (! NILP (current_buffer->enable_multibyte_characters)) while (same_at_end < ZV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) @@ -4360,7 +4348,7 @@ variable `last-coding-system-used' to the coding system actually used. */) /* Replace the chars that we need to replace, and update INSERTED to equal the number of bytes - we are taking from the file. */ + we are taking from the decoded string. */ inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE); if (same_at_end != same_at_start) @@ -4375,20 +4363,25 @@ variable `last-coding-system-used' to the coding system actually used. */) } /* Insert from the file at the proper position. */ SET_PT_BOTH (temp, same_at_start); - insert_1 (conversion_buffer + same_at_start - BEGV_BYTE, inserted, - 0, 0, 0); - if (coding.cmp_data && coding.cmp_data->used) - coding_restore_composition (&coding, Fcurrent_buffer ()); - coding_free_composition_data (&coding); - + same_at_start_charpos + = buf_bytepos_to_charpos (XBUFFER (conversion_buffer), + same_at_start); + inserted_chars + = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer), + same_at_start + inserted) + - same_at_start_charpos); + /* This binding is to avoid ask-user-about-supersession-threat + being called in insert_from_buffer (via in + prepare_to_modify_buffer). */ + specbind (intern ("buffer-file-name"), Qnil); + insert_from_buffer (XBUFFER (conversion_buffer), + same_at_start_charpos, inserted_chars, 0); /* Set `inserted' to the number of inserted characters. */ inserted = PT - temp; /* Set point before the inserted characters. */ SET_PT_BOTH (temp, same_at_start); - xfree (conversion_buffer); - emacs_close (fd); - specpdl_ptr--; + unbind_to (this_count, Qnil); goto handled; } @@ -4441,7 +4434,7 @@ variable `last-coding-system-used' to the coding system actually used. */) inserted = 0; /* Here, we don't do code conversion in the loop. It is done by - code_convert_region after all data are read into the buffer. */ + decode_coding_gap after all data are read into the buffer. */ { int gap_size = GAP_SIZE; @@ -4546,26 +4539,23 @@ variable `last-coding-system-used' to the coding system actually used. */) notfound: - if (! coding_system_decided) + if (NILP (coding_system)) { /* The coding system is not yet decided. Decide it by an optimized method for handling `coding:' tag. Note that we can get here only if the buffer was empty before the insertion. */ - Lisp_Object val; - val = Qnil; if (!NILP (Vcoding_system_for_read)) - val = Vcoding_system_for_read; + coding_system = Vcoding_system_for_read; else { /* Since we are sure that the current buffer was empty before the insertion, we can toggle enable-multibyte-characters directly here without taking - care of marker adjustment and byte combining problem. By - this way, we can run Lisp program safely before decoding - the inserted text. */ + care of marker adjustment. By this way, we can run Lisp + program safely before decoding the inserted text. */ Lisp_Object unwind_data; int count = SPECPDL_INDEX (); @@ -4578,72 +4568,69 @@ variable `last-coding-system-used' to the coding system actually used. */) if (inserted > 0 && ! NILP (Vset_auto_coding_function)) { - val = call2 (Vset_auto_coding_function, - filename, make_number (inserted)); + coding_system = call2 (Vset_auto_coding_function, + filename, make_number (inserted)); } - if (NILP (val)) + if (NILP (coding_system)) { /* If the coding system is not yet decided, check file-coding-system-alist. */ - Lisp_Object args[6], coding_systems; + Lisp_Object args[6]; args[0] = Qinsert_file_contents, args[1] = orig_filename; args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil; - coding_systems = Ffind_operation_coding_system (6, args); - if (CONSP (coding_systems)) - val = XCAR (coding_systems); + coding_system = Ffind_operation_coding_system (6, args); + if (CONSP (coding_system)) + coding_system = XCAR (coding_system); } unbind_to (count, Qnil); inserted = Z_BYTE - BEG_BYTE; } - /* The following kludgy code is to avoid some compiler bug. - We can't simply do - setup_coding_system (val, &coding); - on some system. */ - { - struct coding_system temp_coding; - setup_coding_system (Fcheck_coding_system (val), &temp_coding); - bcopy (&temp_coding, &coding, sizeof coding); - } - /* Ensure we set Vlast_coding_system_used. */ - set_coding_system = 1; + if (NILP (coding_system)) + coding_system = Qundecided; + else + CHECK_CODING_SYSTEM (coding_system); - if (NILP (current_buffer->enable_multibyte_characters) - && ! NILP (val)) + if (NILP (current_buffer->enable_multibyte_characters)) /* We must suppress all character code conversion except for end-of-line conversion. */ - setup_raw_text_coding_system (&coding); - coding.src_multibyte = 0; - coding.dst_multibyte - = !NILP (current_buffer->enable_multibyte_characters); + coding_system = raw_text_coding_system (coding_system); + setup_coding_system (coding_system, &coding); + /* Ensure we set Vlast_coding_system_used. */ + set_coding_system = 1; } - if (!NILP (visit) - /* Can't do this if part of the buffer might be preserved. */ - && NILP (replace) - && (coding.type == coding_type_no_conversion - || coding.type == coding_type_raw_text)) + if (!NILP (visit)) { - /* Visiting a file with these coding system makes the buffer - unibyte. */ - current_buffer->enable_multibyte_characters = Qnil; - coding.dst_multibyte = 0; + /* When we visit a file by raw-text, we change the buffer to + unibyte. */ + if (CODING_FOR_UNIBYTE (&coding) + /* Can't do this if part of the buffer might be preserved. */ + && NILP (replace)) + /* Visiting a file with these coding system makes the buffer + unibyte. */ + current_buffer->enable_multibyte_characters = Qnil; } - if (inserted > 0 || coding.type == coding_type_ccl) + coding.dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters); + if (CODING_MAY_REQUIRE_DECODING (&coding) + && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding))) { - if (CODING_MAY_REQUIRE_DECODING (&coding)) - { - code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, - &coding, 0, 0); - inserted = coding.produced_char; - } - else - adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, - inserted); + move_gap_both (PT, PT_BYTE); + GAP_SIZE += inserted; + ZV_BYTE -= inserted; + Z_BYTE -= inserted; + ZV -= inserted; + Z -= inserted; + decode_coding_gap (&coding, inserted, inserted); + inserted = coding.produced_char; + coding_system = CODING_ID_NAME (coding.id); } + else if (inserted > 0) + adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, + inserted); /* Now INSERTED is measured in characters. */ @@ -4651,8 +4638,8 @@ variable `last-coding-system-used' to the coding system actually used. */) /* Use the conversion type to determine buffer-file-type (find-buffer-file-type is now used to help determine the conversion). */ - if ((coding.eol_type == CODING_EOL_UNDECIDED - || coding.eol_type == CODING_EOL_LF) + if ((VECTORP (CODING_ID_EOL_TYPE (coding.id)) + || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix)) && ! CODING_REQUIRE_DECODING (&coding)) current_buffer->buffer_file_type = Qt; else @@ -4692,7 +4679,7 @@ variable `last-coding-system-used' to the coding system actually used. */) } if (set_coding_system) - Vlast_coding_system_used = coding.symbol; + Vlast_coding_system_used = coding_system; if (! NILP (Ffboundp (Qafter_insert_file_set_coding))) { @@ -4853,8 +4840,6 @@ variable `last-coding-system-used' to the coding system actually used. */) } static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object)); -static Lisp_Object build_annotations_2 P_ ((Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object)); /* If build_annotations switched buffers, switch back to BUF. Kill the temporary buffer that was selected in the meantime. @@ -4879,26 +4864,21 @@ build_annotations_unwind (buf) /* Decide the coding-system to encode the data with. */ -void +static Lisp_Object choose_write_coding_system (start, end, filename, append, visit, lockname, coding) Lisp_Object start, end, filename, append, visit, lockname; struct coding_system *coding; { Lisp_Object val; + Lisp_Object eol_parent = Qnil; if (auto_saving && NILP (Fstring_equal (current_buffer->filename, current_buffer->auto_save_file_name))) { - /* We use emacs-mule for auto saving... */ - setup_coding_system (Qemacs_mule, coding); - /* ... but with the special flag to indicate not to strip off - leading code of eight-bit-control chars. */ - coding->flags = 1; - /* We force LF for end-of-line because that is faster. */ - coding->eol_type = CODING_EOL_LF; - goto done_setup_coding; + val = Qutf_8_emacs; + eol_parent = Qunix; } else if (!NILP (Vcoding_system_for_write)) { @@ -4946,8 +4926,7 @@ choose_write_coding_system (start, end, filename, val = XCDR (coding_systems); } - if (NILP (val) - && !NILP (current_buffer->buffer_file_coding_system)) + if (NILP (val)) { /* If we still have not decided a coding system, use the default value of buffer-file-coding-system. */ @@ -4955,45 +4934,42 @@ choose_write_coding_system (start, end, filename, using_default_coding = 1; } + if (! NILP (val) && ! force_raw_text) + { + Lisp_Object spec, attrs; + + CHECK_CODING_SYSTEM_GET_SPEC (val, spec); + attrs = AREF (spec, 0); + if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text)) + force_raw_text = 1; + } + if (!force_raw_text && !NILP (Ffboundp (Vselect_safe_coding_system_function))) /* Confirm that VAL can surely encode the current region. */ val = call5 (Vselect_safe_coding_system_function, start, end, val, Qnil, filename); - setup_coding_system (Fcheck_coding_system (val), coding); - if (coding->eol_type == CODING_EOL_UNDECIDED - && !using_default_coding) - { - if (! EQ (default_buffer_file_coding.symbol, - buffer_defaults.buffer_file_coding_system)) - setup_coding_system (buffer_defaults.buffer_file_coding_system, - &default_buffer_file_coding); - if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED) - { - Lisp_Object subsidiaries; - - coding->eol_type = default_buffer_file_coding.eol_type; - subsidiaries = Fget (coding->symbol, Qeol_type); - if (VECTORP (subsidiaries) - && XVECTOR (subsidiaries)->size == 3) - coding->symbol - = XVECTOR (subsidiaries)->contents[coding->eol_type]; - } - } + /* If the decided coding-system doesn't specify end-of-line + format, we use that of + `default-buffer-file-coding-system'. */ + if (! using_default_coding + && ! NILP (buffer_defaults.buffer_file_coding_system)) + val = (coding_inherit_eol_type + (val, buffer_defaults.buffer_file_coding_system)); + /* If we decide not to encode text, use `raw-text' or one of its + subsidiaries. */ if (force_raw_text) - setup_raw_text_coding_system (coding); - goto done_setup_coding; + val = raw_text_coding_system (val); } - setup_coding_system (Fcheck_coding_system (val), coding); + val = coding_inherit_eol_type (val, eol_parent); + setup_coding_system (val, coding); - done_setup_coding: - if (coding->eol_type == CODING_EOL_UNDECIDED) - coding->eol_type = system_eol_type; if (!STRINGP (start) && !NILP (current_buffer->selective_display)) coding->mode |= CODING_MODE_SELECTIVE_DISPLAY; + return val; } DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7, @@ -5038,7 +5014,6 @@ This does code conversion according to the value of int save_errno = 0; const unsigned char *fn; struct stat st; - int tem; int count = SPECPDL_INDEX (); int count1; #ifdef VMS @@ -5138,21 +5113,9 @@ This does code conversion according to the value of We used to make this choice before calling build_annotations, but that leads to problems when a write-annotate-function takes care of unsavable chars (as was the case with X-Symbol). */ - choose_write_coding_system (start, end, filename, - append, visit, lockname, &coding); - Vlast_coding_system_used = coding.symbol; - - given_buffer = current_buffer; - if (! STRINGP (start)) - { - annotations = build_annotations_2 (start, end, - coding.pre_write_conversion, annotations); - if (current_buffer != given_buffer) - { - XSETFASTINT (start, BEGV); - XSETFASTINT (end, ZV); - } - } + Vlast_coding_system_used + = choose_write_coding_system (start, end, filename, + append, visit, lockname, &coding); #ifdef CLASH_DETECTION if (!auto_saving) @@ -5290,6 +5253,9 @@ This does code conversion according to the value of if (GPT > BEG && GPT_ADDR[-1] != '\n') move_gap (find_next_newline (GPT, 1)); #else +#if 0 + /* The new encoding routine doesn't require the following. */ + /* Whether VMS or not, we must move the gap to the next of newline when we must put designation sequences at beginning of line. */ if (INTEGERP (start) @@ -5303,6 +5269,7 @@ This does code conversion according to the value of SET_PT_BOTH (opoint, opoint_byte); } #endif +#endif failure = 0; immediate_quit = 1; @@ -5315,23 +5282,10 @@ This does code conversion according to the value of } else if (XINT (start) != XINT (end)) { - tem = CHAR_TO_BYTE (XINT (start)); - - if (XINT (start) < GPT) - { - failure = 0 > a_write (desc, Qnil, XINT (start), - min (GPT, XINT (end)) - XINT (start), - &annotations, &coding); - save_errno = errno; - } - - if (XINT (end) > GPT && !failure) - { - tem = max (XINT (start), GPT); - failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem, - &annotations, &coding); - save_errno = errno; - } + failure = 0 > a_write (desc, Qnil, + XINT (start), XINT (end) - XINT (start), + &annotations, &coding); + save_errno = errno; } else { @@ -5347,7 +5301,7 @@ This does code conversion according to the value of { /* We have to flush out a data. */ coding.mode |= CODING_MODE_LAST_BLOCK; - failure = 0 > e_write (desc, Qnil, 0, 0, &coding); + failure = 0 > e_write (desc, Qnil, 1, 1, &coding); save_errno = errno; } @@ -5546,30 +5500,6 @@ build_annotations (start, end) return annotations; } -static Lisp_Object -build_annotations_2 (start, end, pre_write_conversion, annotations) - Lisp_Object start, end, pre_write_conversion, annotations; -{ - struct gcpro gcpro1; - Lisp_Object res; - - GCPRO1 (annotations); - /* At last, do the same for the function PRE_WRITE_CONVERSION - implied by the current coding-system. */ - if (!NILP (pre_write_conversion)) - { - struct buffer *given_buffer = current_buffer; - Vwrite_region_annotations_so_far = annotations; - res = call2 (pre_write_conversion, start, end); - Flength (res); - annotations = (current_buffer != given_buffer - ? res - : merge (annotations, res, Qcar_less_than_car)); - } - - UNGCPRO; - return annotations; -} /* Write to descriptor DESC the NCHARS chars starting at POS of STRING. If STRING is nil, POS is the character position in the current buffer. @@ -5625,9 +5555,6 @@ a_write (desc, string, pos, nchars, annot, coding) return 0; } -#ifndef WRITE_BUF_SIZE -#define WRITE_BUF_SIZE (16 * 1024) -#endif /* Write text in the range START and END into descriptor DESC, encoding them with coding system CODING. If STRING is nil, START @@ -5641,78 +5568,77 @@ e_write (desc, string, start, end, coding) int start, end; struct coding_system *coding; { - register char *addr; - register int nbytes; - char buf[WRITE_BUF_SIZE]; - int return_val = 0; - - if (start >= end) - coding->composing = COMPOSITION_DISABLED; - if (coding->composing != COMPOSITION_DISABLED) - coding_save_composition (coding, start, end, string); - if (STRINGP (string)) { - addr = SDATA (string); - nbytes = SBYTES (string); - coding->src_multibyte = STRING_MULTIBYTE (string); - } - else if (start < end) - { - /* It is assured that the gap is not in the range START and END-1. */ - addr = CHAR_POS_ADDR (start); - nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start); - coding->src_multibyte - = !NILP (current_buffer->enable_multibyte_characters); - } - else - { - addr = ""; - nbytes = 0; - coding->src_multibyte = 1; + start = 0; + end = SCHARS (string); } /* We used to have a code for handling selective display here. But, now it is handled within encode_coding. */ - while (1) - { - int result; - result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE); - if (coding->produced > 0) + while (start < end) + { + if (STRINGP (string)) { - coding->produced -= emacs_write (desc, buf, coding->produced); - if (coding->produced) + coding->src_multibyte = SCHARS (string) < SBYTES (string); + if (CODING_REQUIRE_ENCODING (coding)) { - return_val = -1; - break; + encode_coding_object (coding, string, + start, string_char_to_byte (string, start), + end, string_char_to_byte (string, end), Qt); + } + else + { + coding->dst_object = string; + coding->consumed_char = SCHARS (string); + coding->produced = SBYTES (string); } } - nbytes -= coding->consumed; - addr += coding->consumed; - if (result == CODING_FINISH_INSUFFICIENT_SRC - && nbytes > 0) + else { - /* The source text ends by an incomplete multibyte form. - There's no way other than write it out as is. */ - nbytes -= emacs_write (desc, addr, nbytes); - if (nbytes) + int start_byte = CHAR_TO_BYTE (start); + int end_byte = CHAR_TO_BYTE (end); + + coding->src_multibyte = (end - start) < (end_byte - start_byte); + if (CODING_REQUIRE_ENCODING (coding)) { - return_val = -1; - break; + encode_coding_object (coding, Fcurrent_buffer (), + start, start_byte, end, end_byte, Qt); + } + else + { + coding->dst_object = Qnil; + coding->dst_pos_byte = start_byte; + if (start >= GPT || end <= GPT) + { + coding->consumed_char = end - start; + coding->produced = end_byte - start_byte; + } + else + { + coding->consumed_char = GPT - start; + coding->produced = GPT_BYTE - start_byte; + } } } - if (nbytes <= 0) - break; + + if (coding->produced > 0) + { + coding->produced -= + emacs_write (desc, + STRINGP (coding->dst_object) + ? SDATA (coding->dst_object) + : BYTE_POS_ADDR (coding->dst_pos_byte), + coding->produced); + + if (coding->produced) + return -1; + } start += coding->consumed_char; - if (coding->cmp_data) - coding_adjust_composition_offset (coding, start); } - if (coding->cmp_data) - coding_free_composition_data (coding); - - return return_val; + return 0; } DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, @@ -6013,7 +5939,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) couldn't handle some ange-ftp'd file. */ for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) - for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { buf = XCDR (XCAR (tail)); b = XBUFFER (buf); @@ -6290,9 +6216,9 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte { Lisp_Object tem = XCAR (all); int len; - if (STRINGP (tem) - && (len = SBYTES (tem), len > 0) - && IS_DIRECTORY_SEP (SREF (tem, len-1))) + if (STRINGP (tem) && + (len = SBYTES (tem), len > 0) && + IS_DIRECTORY_SEP (SREF (tem, len-1))) comp = Fcons (tem, comp); } } diff --git a/src/filelock.c b/src/filelock.c index 4c211bf9947..b479a802866 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -53,7 +53,7 @@ extern int errno; #include "lisp.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "systime.h" @@ -666,7 +666,7 @@ unlock_all_files () register Lisp_Object tail; register struct buffer *b; - for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { b = XBUFFER (XCDR (XCAR (tail))); if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) diff --git a/src/fns.c b/src/fns.c index 618ccb5025f..82f9501f7aa 100644 --- a/src/fns.c +++ b/src/fns.c @@ -39,7 +39,7 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "commands.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "buffer.h" #include "keyboard.h" @@ -151,8 +151,6 @@ To get the number of bytes, use `string-bytes'. */) XSETFASTINT (val, SCHARS (sequence)); else if (VECTORP (sequence)) XSETFASTINT (val, ASIZE (sequence)); - else if (SUB_CHAR_TABLE_P (sequence)) - XSETFASTINT (val, SUB_CHAR_TABLE_ORDINARY_SLOTS); else if (CHAR_TABLE_P (sequence)) XSETFASTINT (val, MAX_CHAR); else if (BOOL_VECTOR_P (sequence)) @@ -217,7 +215,7 @@ which is at least the number of distinct elements. */) DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0, doc: /* Return the number of bytes in STRING. -If STRING is a multibyte string, this is greater than the length of STRING. */) +If STRING is multibyte, this may be greater than the length of STRING. */) (string) Lisp_Object string; { @@ -464,28 +462,6 @@ usage: (vconcat &rest SEQUENCES) */) return concat (nargs, args, Lisp_Vectorlike, 0); } -/* Return a copy of a sub char table ARG. The elements except for a - nested sub char table are not copied. */ -static Lisp_Object -copy_sub_char_table (arg) - Lisp_Object arg; -{ - Lisp_Object copy = make_sub_char_table (Qnil); - int i; - - XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (arg)->defalt; - /* Copy all the contents. */ - bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents, - SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object)); - /* Recursively copy any sub char-tables in the ordinary slots. */ - for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++) - if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i])) - XCHAR_TABLE (copy)->contents[i] - = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]); - - return copy; -} - DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, doc: /* Return a copy of a list, vector, string or char-table. @@ -498,24 +474,7 @@ with the original. */) if (CHAR_TABLE_P (arg)) { - int i; - Lisp_Object copy; - - copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil); - /* Copy all the slots, including the extra ones. */ - bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents, - ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK) - * sizeof (Lisp_Object))); - - /* Recursively copy any sub char tables in the ordinary slots - for multibyte characters. */ - for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; - i < CHAR_TABLE_ORDINARY_SLOTS; i++) - if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i])) - XCHAR_TABLE (copy)->contents[i] - = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]); - - return copy; + return copy_char_table (arg); } if (BOOL_VECTOR_P (arg)) @@ -618,10 +577,10 @@ concat (nargs, args, target_type, last_special) for (i = 0; i < len; i++) { ch = AREF (this, i); - CHECK_NUMBER (ch); + CHECK_CHARACTER (ch); this_len_byte = CHAR_BYTES (XINT (ch)); result_len_byte += this_len_byte; - if (!SINGLE_BYTE_CHAR_P (XINT (ch))) + if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch))) some_multibyte = 1; } else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0) @@ -630,10 +589,10 @@ concat (nargs, args, target_type, last_special) for (; CONSP (this); this = XCDR (this)) { ch = XCAR (this); - CHECK_NUMBER (ch); + CHECK_CHARACTER (ch); this_len_byte = CHAR_BYTES (XINT (ch)); result_len_byte += this_len_byte; - if (!SINGLE_BYTE_CHAR_P (XINT (ch))) + if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch))) some_multibyte = 1; } else if (STRINGP (this)) @@ -749,9 +708,7 @@ concat (nargs, args, target_type, last_special) { XSETFASTINT (elt, SREF (this, thisindex)); thisindex++; if (some_multibyte - && (XINT (elt) >= 0240 - || (XINT (elt) >= 0200 - && ! NILP (Vnonascii_translation_table))) + && XINT (elt) >= 0200 && XINT (elt) < 0400) { c = unibyte_char_to_multibyte (XINT (elt)); @@ -784,28 +741,12 @@ concat (nargs, args, target_type, last_special) else { CHECK_NUMBER (elt); - if (SINGLE_BYTE_CHAR_P (XINT (elt))) - { - if (some_multibyte) - toindex_byte - += CHAR_STRING (XINT (elt), - SDATA (val) + toindex_byte); - else - SSET (val, toindex_byte++, XINT (elt)); - toindex++; - } + if (some_multibyte) + toindex_byte += CHAR_STRING (XINT (elt), + SDATA (val) + toindex_byte); else - /* If we have any multibyte characters, - we already decided to make a multibyte string. */ - { - int c = XINT (elt); - /* P exists as a variable - to avoid a bug on the Masscomp C compiler. */ - unsigned char *p = SDATA (val) + toindex_byte; - - toindex_byte += CHAR_STRING (c, p); - toindex++; - } + SSET (val, toindex_byte++, XINT (elt)); + toindex++; } } } @@ -855,7 +796,7 @@ string_char_to_byte (string, char_index) Lisp_Object string; int char_index; { - int i, i_byte; + int i_byte; int best_below, best_below_byte; int best_above, best_above_byte; @@ -881,40 +822,30 @@ string_char_to_byte (string, char_index) if (char_index - best_below < best_above - char_index) { + unsigned char *p = SDATA (string) + best_below_byte; + while (best_below < char_index) { - int c; - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, - best_below, best_below_byte); + p += BYTES_BY_CHAR_HEAD (*p); + best_below++; } - i = best_below; - i_byte = best_below_byte; + i_byte = p - SDATA (string); } else { + unsigned char *p = SDATA (string) + best_above_byte; + while (best_above > char_index) { - unsigned char *pend = SDATA (string) + best_above_byte; - unsigned char *pbeg = pend - best_above_byte; - unsigned char *p = pend - 1; - int bytes; - - while (p > pbeg && !CHAR_HEAD_P (*p)) p--; - PARSE_MULTIBYTE_SEQ (p, pend - p, bytes); - if (bytes == pend - p) - best_above_byte -= bytes; - else if (bytes > pend - p) - best_above_byte -= (pend - p); - else - best_above_byte--; + p--; + while (!CHAR_HEAD_P (*p)) p--; best_above--; } - i = best_above; - i_byte = best_above_byte; + i_byte = p - SDATA (string); } string_char_byte_cache_bytepos = i_byte; - string_char_byte_cache_charpos = i; + string_char_byte_cache_charpos = char_index; string_char_byte_cache_string = string; return i_byte; @@ -953,36 +884,30 @@ string_byte_to_char (string, byte_index) if (byte_index - best_below_byte < best_above_byte - byte_index) { - while (best_below_byte < byte_index) + unsigned char *p = SDATA (string) + best_below_byte; + unsigned char *pend = SDATA (string) + byte_index; + + while (p < pend) { - int c; - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, - best_below, best_below_byte); + p += BYTES_BY_CHAR_HEAD (*p); + best_below++; } i = best_below; - i_byte = best_below_byte; + i_byte = p - SDATA (string); } else { - while (best_above_byte > byte_index) + unsigned char *p = SDATA (string) + best_above_byte; + unsigned char *pbeg = SDATA (string) + byte_index; + + while (p > pbeg) { - unsigned char *pend = SDATA (string) + best_above_byte; - unsigned char *pbeg = pend - best_above_byte; - unsigned char *p = pend - 1; - int bytes; - - while (p > pbeg && !CHAR_HEAD_P (*p)) p--; - PARSE_MULTIBYTE_SEQ (p, pend - p, bytes); - if (bytes == pend - p) - best_above_byte -= bytes; - else if (bytes > pend - p) - best_above_byte -= (pend - p); - else - best_above_byte--; + p--; + while (!CHAR_HEAD_P (*p)) p--; best_above--; } i = best_above; - i_byte = best_above_byte; + i_byte = p - SDATA (string); } string_char_byte_cache_bytepos = i_byte; @@ -992,9 +917,7 @@ string_byte_to_char (string, byte_index) return i; } -/* Convert STRING to a multibyte string. - Single-byte characters 0240 through 0377 are converted - by adding nonascii_insert_offset to each. */ +/* Convert STRING to a multibyte string. */ Lisp_Object string_make_multibyte (string) @@ -1026,10 +949,9 @@ string_make_multibyte (string) } -/* Convert STRING to a multibyte string without changing each - character codes. Thus, characters 0200 trough 0237 are converted - to eight-bit-control characters, and characters 0240 through 0377 - are converted eight-bit-graphic characters. */ +/* Convert STRING (if unibyte) to a multibyte string without changing + the number of characters. Characters 0200 trough 0237 are + converted to eight-bit characters. */ Lisp_Object string_to_multibyte (string) @@ -1044,8 +966,8 @@ string_to_multibyte (string) return string; nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string)); - /* If all the chars are ASCII or eight-bit-graphic, they won't need - any more bytes once converted. */ + /* If all the chars are ASCII, they won't need any more bytes once + converted. */ if (nbytes == SBYTES (string)) return make_multibyte_string (SDATA (string), nbytes, nbytes); @@ -1126,8 +1048,7 @@ DEFUN ("string-as-unibyte", Fstring_as_unibyte, Sstring_as_unibyte, If STRING is unibyte, the result is STRING itself. Otherwise it is a newly created string, with no text properties. If STRING is multibyte and contains a character of charset -`eight-bit-control' or `eight-bit-graphic', it is converted to the -corresponding single byte. */) +`eight-bit', it is converted to the corresponding single byte. */) (string) Lisp_Object string; { @@ -1151,20 +1072,16 @@ DEFUN ("string-as-multibyte", Fstring_as_multibyte, Sstring_as_multibyte, doc: /* Return a multibyte string with the same individual bytes as STRING. If STRING is multibyte, the result is STRING itself. Otherwise it is a newly created string, with no text properties. + If STRING is unibyte and contains an individual 8-bit byte (i.e. not -part of a multibyte form), it is converted to the corresponding -multibyte character of charset `eight-bit-control' or `eight-bit-graphic'. +part of a correct utf-8 sequence), it is converted to the corresponding +multibyte character of charset `eight-bit'. +See also `string-to-multibyte'. + Beware, this often doesn't really do what you think it does. -It is similar to (decode-coding-string STRING 'emacs-mule-unix). +It is similar to (decode-coding-string STRING 'utf-8-emacs). If you're not sure, whether to use `string-as-multibyte' or -`string-to-multibyte', use `string-to-multibyte'. Beware: - (aref (string-as-multibyte "\\201") 0) -> 129 (aka ?\\201) - (aref (string-as-multibyte "\\300") 0) -> 192 (aka ?\\300) - (aref (string-as-multibyte "\\300\\201") 0) -> 192 (aka ?\\300) - (aref (string-as-multibyte "\\300\\201") 1) -> 129 (aka ?\\201) -but - (aref (string-as-multibyte "\\201\\300") 0) -> 2240 - (aref (string-as-multibyte "\\201\\300") 1) -> <error> */) +`string-to-multibyte', use `string-to-multibyte'. */) (string) Lisp_Object string; { @@ -1195,11 +1112,13 @@ DEFUN ("string-to-multibyte", Fstring_to_multibyte, Sstring_to_multibyte, doc: /* Return a multibyte string with the same individual chars as STRING. If STRING is multibyte, the result is STRING itself. Otherwise it is a newly created string, with no text properties. -Characters 0200 through 0237 are converted to eight-bit-control -characters of the same character code. Characters 0240 through 0377 -are converted to eight-bit-graphic characters of the same character -codes. -This is similar to (decode-coding-string STRING 'binary) */) + +If STRING is unibyte and contains an 8-bit byte, it is converted to +the corresponding multibyte character of charset `eight-bit'. + +This differs from `string-as-multibyte' by converting each byte of a correct +utf-8 sequence to an eight-bit character, not just bytes that don't form a +correct sequence. */) (string) Lisp_Object string; { @@ -1599,6 +1518,22 @@ The value is actually the first element of LIST whose car equals KEY. */) return CAR (list); } +/* Like Fassoc but never report an error and do not allow quits. + Use only on lists known never to be circular. */ + +Lisp_Object +assoc_no_quit (key, list) + Lisp_Object key, list; +{ + while (CONSP (list) + && (!CONSP (XCAR (list)) + || (!EQ (XCAR (XCAR (list)), key) + && NILP (Fequal (XCAR (XCAR (list)), key))))) + list = XCDR (list); + + return CONSP (list) ? XCAR (list) : Qnil; +} + DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. The value is actually the first element of LIST whose cdr is KEY. */) @@ -2270,7 +2205,8 @@ internal_equal (o1, o2, depth, props) functions are sensible to compare, so eliminate the others now. */ if (size & PSEUDOVECTOR_FLAG) { - if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE))) + if (!(size & (PVEC_COMPILED + | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE))) return 0; size &= PSEUDOVECTOR_SIZE_MASK; } @@ -2325,11 +2261,11 @@ ARRAY is a vector, string, char-table, or bool-vector. */) } else if (CHAR_TABLE_P (array)) { - register Lisp_Object *p = XCHAR_TABLE (array)->contents; - size = CHAR_TABLE_ORDINARY_SLOTS; - for (index = 0; index < size; index++) - p[index] = item; - XCHAR_TABLE (array)->defalt = Qnil; + int i; + + for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++) + XCHAR_TABLE (array)->contents[i] = item; + XCHAR_TABLE (array)->defalt = item; } else if (STRINGP (array)) { @@ -2399,582 +2335,6 @@ This makes STRING unibyte and may change its length. */) return Qnil; } -DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype, - 1, 1, 0, - doc: /* Return the subtype of char-table CHAR-TABLE. The value is a symbol. */) - (char_table) - Lisp_Object char_table; -{ - CHECK_CHAR_TABLE (char_table); - - return XCHAR_TABLE (char_table)->purpose; -} - -DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent, - 1, 1, 0, - doc: /* Return the parent char-table of CHAR-TABLE. -The value is either nil or another char-table. -If CHAR-TABLE holds nil for a given character, -then the actual applicable value is inherited from the parent char-table -\(or from its parents, if necessary). */) - (char_table) - Lisp_Object char_table; -{ - CHECK_CHAR_TABLE (char_table); - - return XCHAR_TABLE (char_table)->parent; -} - -DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent, - 2, 2, 0, - doc: /* Set the parent char-table of CHAR-TABLE to PARENT. -Return PARENT. PARENT must be either nil or another char-table. */) - (char_table, parent) - Lisp_Object char_table, parent; -{ - Lisp_Object temp; - - CHECK_CHAR_TABLE (char_table); - - if (!NILP (parent)) - { - CHECK_CHAR_TABLE (parent); - - for (temp = parent; CHAR_TABLE_P (temp); - temp = XCHAR_TABLE (temp)->parent) - if (EQ (temp, char_table)) - error ("Attempt to make a chartable be its own parent"); - } - - XCHAR_TABLE (char_table)->parent = parent; - - return parent; -} - -DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot, - 2, 2, 0, - doc: /* Return the value of CHAR-TABLE's extra-slot number N. */) - (char_table, n) - Lisp_Object char_table, n; -{ - CHECK_CHAR_TABLE (char_table); - CHECK_NUMBER (n); - if (XINT (n) < 0 - || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) - args_out_of_range (char_table, n); - - return XCHAR_TABLE (char_table)->extras[XINT (n)]; -} - -DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, - Sset_char_table_extra_slot, - 3, 3, 0, - doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */) - (char_table, n, value) - Lisp_Object char_table, n, value; -{ - CHECK_CHAR_TABLE (char_table); - CHECK_NUMBER (n); - if (XINT (n) < 0 - || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) - args_out_of_range (char_table, n); - - return XCHAR_TABLE (char_table)->extras[XINT (n)] = value; -} - -static Lisp_Object -char_table_range (table, from, to, defalt) - Lisp_Object table; - int from, to; - Lisp_Object defalt; -{ - Lisp_Object val; - - if (! NILP (XCHAR_TABLE (table)->defalt)) - defalt = XCHAR_TABLE (table)->defalt; - val = XCHAR_TABLE (table)->contents[from]; - if (SUB_CHAR_TABLE_P (val)) - val = char_table_range (val, 32, 127, defalt); - else if (NILP (val)) - val = defalt; - for (from++; from <= to; from++) - { - Lisp_Object this_val; - - this_val = XCHAR_TABLE (table)->contents[from]; - if (SUB_CHAR_TABLE_P (this_val)) - this_val = char_table_range (this_val, 32, 127, defalt); - else if (NILP (this_val)) - this_val = defalt; - if (! EQ (val, this_val)) - error ("Characters in the range have inconsistent values"); - } - return val; -} - - -DEFUN ("char-table-range", Fchar_table_range, Schar_table_range, - 2, 2, 0, - doc: /* Return the value in CHAR-TABLE for a range of characters RANGE. -RANGE should be nil (for the default value), -a vector which identifies a character set or a row of a character set, -a character set name, or a character code. -If the characters in the specified range have different values, -an error is signaled. - -Note that this function doesn't check the parent of CHAR-TABLE. */) - (char_table, range) - Lisp_Object char_table, range; -{ - int charset_id, c1 = 0, c2 = 0; - int size; - Lisp_Object ch, val, current_default; - - CHECK_CHAR_TABLE (char_table); - - if (EQ (range, Qnil)) - return XCHAR_TABLE (char_table)->defalt; - if (INTEGERP (range)) - { - int c = XINT (range); - if (! CHAR_VALID_P (c, 0)) - error ("Invalid character code: %d", c); - ch = range; - SPLIT_CHAR (c, charset_id, c1, c2); - } - else if (SYMBOLP (range)) - { - Lisp_Object charset_info; - - charset_info = Fget (range, Qcharset); - CHECK_VECTOR (charset_info); - charset_id = XINT (AREF (charset_info, 0)); - ch = Fmake_char_internal (make_number (charset_id), - make_number (0), make_number (0)); - } - else if (VECTORP (range)) - { - size = ASIZE (range); - if (size == 0) - args_out_of_range (range, make_number (0)); - CHECK_NUMBER (AREF (range, 0)); - charset_id = XINT (AREF (range, 0)); - if (size > 1) - { - CHECK_NUMBER (AREF (range, 1)); - c1 = XINT (AREF (range, 1)); - if (size > 2) - { - CHECK_NUMBER (AREF (range, 2)); - c2 = XINT (AREF (range, 2)); - } - } - - /* This checks if charset_id, c0, and c1 are all valid or not. */ - ch = Fmake_char_internal (make_number (charset_id), - make_number (c1), make_number (c2)); - } - else - error ("Invalid RANGE argument to `char-table-range'"); - - if (c1 > 0 && (CHARSET_DIMENSION (charset_id) == 1 || c2 > 0)) - { - /* Fully specified character. */ - Lisp_Object parent = XCHAR_TABLE (char_table)->parent; - - XCHAR_TABLE (char_table)->parent = Qnil; - val = Faref (char_table, ch); - XCHAR_TABLE (char_table)->parent = parent; - return val; - } - - current_default = XCHAR_TABLE (char_table)->defalt; - if (charset_id == CHARSET_ASCII - || charset_id == CHARSET_8_BIT_CONTROL - || charset_id == CHARSET_8_BIT_GRAPHIC) - { - int from, to, defalt; - - if (charset_id == CHARSET_ASCII) - from = 0, to = 127, defalt = CHAR_TABLE_DEFAULT_SLOT_ASCII; - else if (charset_id == CHARSET_8_BIT_CONTROL) - from = 128, to = 159, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL; - else - from = 160, to = 255, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC; - if (! NILP (XCHAR_TABLE (char_table)->contents[defalt])) - current_default = XCHAR_TABLE (char_table)->contents[defalt]; - return char_table_range (char_table, from, to, current_default); - } - - val = XCHAR_TABLE (char_table)->contents[128 + charset_id]; - if (! SUB_CHAR_TABLE_P (val)) - return (NILP (val) ? current_default : val); - if (! NILP (XCHAR_TABLE (val)->defalt)) - current_default = XCHAR_TABLE (val)->defalt; - if (c1 == 0) - return char_table_range (val, 32, 127, current_default); - val = XCHAR_TABLE (val)->contents[c1]; - if (! SUB_CHAR_TABLE_P (val)) - return (NILP (val) ? current_default : val); - if (! NILP (XCHAR_TABLE (val)->defalt)) - current_default = XCHAR_TABLE (val)->defalt; - return char_table_range (val, 32, 127, current_default); -} - -DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range, - 3, 3, 0, - doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE. -RANGE should be t (for all characters), nil (for the default value), -a character set, a vector which identifies a character set, a row of a -character set, or a character code. Return VALUE. */) - (char_table, range, value) - Lisp_Object char_table, range, value; -{ - int i; - - CHECK_CHAR_TABLE (char_table); - - if (EQ (range, Qt)) - for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++) - { - /* Don't set these special slots used for default values of - ascii, eight-bit-control, and eight-bit-graphic. */ - if (i != CHAR_TABLE_DEFAULT_SLOT_ASCII - && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL - && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC) - XCHAR_TABLE (char_table)->contents[i] = value; - } - else if (EQ (range, Qnil)) - XCHAR_TABLE (char_table)->defalt = value; - else if (SYMBOLP (range)) - { - Lisp_Object charset_info; - int charset_id; - - charset_info = Fget (range, Qcharset); - if (! VECTORP (charset_info) - || ! NATNUMP (AREF (charset_info, 0)) - || (charset_id = XINT (AREF (charset_info, 0)), - ! CHARSET_DEFINED_P (charset_id))) - error ("Invalid charset: %s", SDATA (SYMBOL_NAME (range))); - - if (charset_id == CHARSET_ASCII) - for (i = 0; i < 128; i++) - XCHAR_TABLE (char_table)->contents[i] = value; - else if (charset_id == CHARSET_8_BIT_CONTROL) - for (i = 128; i < 160; i++) - XCHAR_TABLE (char_table)->contents[i] = value; - else if (charset_id == CHARSET_8_BIT_GRAPHIC) - for (i = 160; i < 256; i++) - XCHAR_TABLE (char_table)->contents[i] = value; - else - XCHAR_TABLE (char_table)->contents[charset_id + 128] = value; - } - else if (INTEGERP (range)) - Faset (char_table, range, value); - else if (VECTORP (range)) - { - int size = ASIZE (range); - Lisp_Object *val = XVECTOR (range)->contents; - Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0], - size <= 1 ? Qnil : val[1], - size <= 2 ? Qnil : val[2]); - Faset (char_table, ch, value); - } - else - error ("Invalid RANGE argument to `set-char-table-range'"); - - return value; -} - -DEFUN ("set-char-table-default", Fset_char_table_default, - Sset_char_table_default, 3, 3, 0, - doc: /* Set the default value in CHAR-TABLE for generic character CH to VALUE. -The generic character specifies the group of characters. -If CH is a normal character, set the default value for a group of -characters to which CH belongs. -See also the documentation of `make-char'. */) - (char_table, ch, value) - Lisp_Object char_table, ch, value; -{ - int c, charset, code1, code2; - Lisp_Object temp; - - CHECK_CHAR_TABLE (char_table); - CHECK_NUMBER (ch); - - c = XINT (ch); - SPLIT_CHAR (c, charset, code1, code2); - - /* Since we may want to set the default value for a character set - not yet defined, we check only if the character set is in the - valid range or not, instead of it is already defined or not. */ - if (! CHARSET_VALID_P (charset)) - invalid_character (c); - - if (SINGLE_BYTE_CHAR_P (c)) - { - /* We use special slots for the default values of single byte - characters. */ - int default_slot - = (c < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII - : c < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL - : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC); - - return (XCHAR_TABLE (char_table)->contents[default_slot] = value); - } - - /* Even if C is not a generic char, we had better behave as if a - generic char is specified. */ - if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1) - code1 = 0; - temp = XCHAR_TABLE (char_table)->contents[charset + 128]; - if (! SUB_CHAR_TABLE_P (temp)) - { - temp = make_sub_char_table (temp); - XCHAR_TABLE (char_table)->contents[charset + 128] = temp; - } - if (!code1) - { - XCHAR_TABLE (temp)->defalt = value; - return value; - } - char_table = temp; - temp = XCHAR_TABLE (char_table)->contents[code1]; - if (SUB_CHAR_TABLE_P (temp)) - XCHAR_TABLE (temp)->defalt = value; - else - XCHAR_TABLE (char_table)->contents[code1] = value; - return value; -} - -/* Look up the element in TABLE at index CH, - and return it as an integer. - If the element is nil, return CH itself. - (Actually we do that for any non-integer.) */ - -int -char_table_translate (table, ch) - Lisp_Object table; - int ch; -{ - Lisp_Object value; - value = Faref (table, make_number (ch)); - if (! INTEGERP (value)) - return ch; - return XINT (value); -} - -static void -optimize_sub_char_table (table, chars) - Lisp_Object *table; - int chars; -{ - Lisp_Object elt; - int from, to; - - if (chars == 94) - from = 33, to = 127; - else - from = 32, to = 128; - - if (!SUB_CHAR_TABLE_P (*table) - || ! NILP (XCHAR_TABLE (*table)->defalt)) - return; - elt = XCHAR_TABLE (*table)->contents[from++]; - for (; from < to; from++) - if (NILP (Fequal (elt, XCHAR_TABLE (*table)->contents[from]))) - return; - *table = elt; -} - -DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table, - 1, 1, 0, doc: /* Optimize char table TABLE. */) - (table) - Lisp_Object table; -{ - Lisp_Object elt; - int dim, chars; - int i, j; - - CHECK_CHAR_TABLE (table); - - for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++) - { - elt = XCHAR_TABLE (table)->contents[i]; - if (!SUB_CHAR_TABLE_P (elt)) - continue; - dim = CHARSET_DIMENSION (i - 128); - chars = CHARSET_CHARS (i - 128); - if (dim == 2) - for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++) - optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, chars); - optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, chars); - } - return Qnil; -} - - -/* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each - character or group of characters that share a value. - DEPTH is the current depth in the originally specified - chartable, and INDICES contains the vector indices - for the levels our callers have descended. - - ARG is passed to C_FUNCTION when that is called. */ - -void -map_char_table (c_function, function, table, subtable, arg, depth, indices) - void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); - Lisp_Object function, table, subtable, arg; - int depth, *indices; -{ - int i, to; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - GCPRO4 (arg, table, subtable, function); - - if (depth == 0) - { - /* At first, handle ASCII and 8-bit European characters. */ - for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++) - { - Lisp_Object elt= XCHAR_TABLE (subtable)->contents[i]; - if (NILP (elt)) - elt = XCHAR_TABLE (subtable)->defalt; - if (NILP (elt)) - elt = Faref (subtable, make_number (i)); - if (c_function) - (*c_function) (arg, make_number (i), elt); - else - call2 (function, make_number (i), elt); - } -#if 0 /* If the char table has entries for higher characters, - we should report them. */ - if (NILP (current_buffer->enable_multibyte_characters)) - { - UNGCPRO; - return; - } -#endif - to = CHAR_TABLE_ORDINARY_SLOTS; - } - else - { - int charset = indices[0] - 128; - - i = 32; - to = SUB_CHAR_TABLE_ORDINARY_SLOTS; - if (CHARSET_CHARS (charset) == 94) - i++, to--; - } - - for (; i < to; i++) - { - Lisp_Object elt; - int charset; - - elt = XCHAR_TABLE (subtable)->contents[i]; - indices[depth] = i; - charset = indices[0] - 128; - if (depth == 0 - && (!CHARSET_DEFINED_P (charset) - || charset == CHARSET_8_BIT_CONTROL - || charset == CHARSET_8_BIT_GRAPHIC)) - continue; - - if (SUB_CHAR_TABLE_P (elt)) - { - if (depth >= 3) - error ("Too deep char table"); - map_char_table (c_function, function, table, elt, arg, depth + 1, indices); - } - else - { - int c1, c2, c; - - c1 = depth >= 1 ? indices[1] : 0; - c2 = depth >= 2 ? indices[2] : 0; - c = MAKE_CHAR (charset, c1, c2); - - if (NILP (elt)) - elt = XCHAR_TABLE (subtable)->defalt; - if (NILP (elt)) - elt = Faref (table, make_number (c)); - - if (c_function) - (*c_function) (arg, make_number (c), elt); - else - call2 (function, make_number (c), elt); - } - } - UNGCPRO; -} - -static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c)); -static void -void_call2 (a, b, c) - Lisp_Object a, b, c; -{ - call2 (a, b, c); -} - -DEFUN ("map-char-table", Fmap_char_table, Smap_char_table, - 2, 2, 0, - doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE. -FUNCTION is called with two arguments--a key and a value. -The key is always a possible IDX argument to `aref'. */) - (function, char_table) - Lisp_Object function, char_table; -{ - /* The depth of char table is at most 3. */ - int indices[3]; - - CHECK_CHAR_TABLE (char_table); - - /* When Lisp_Object is represented as a union, `call2' cannot directly - be passed to map_char_table because it returns a Lisp_Object rather - than returning nothing. - Casting leads to crashes on some architectures. --Stef */ - map_char_table (void_call2, Qnil, char_table, char_table, function, 0, indices); - return Qnil; -} - -/* Return a value for character C in char-table TABLE. Store the - actual index for that value in *IDX. Ignore the default value of - TABLE. */ - -Lisp_Object -char_table_ref_and_index (table, c, idx) - Lisp_Object table; - int c, *idx; -{ - int charset, c1, c2; - Lisp_Object elt; - - if (SINGLE_BYTE_CHAR_P (c)) - { - *idx = c; - return XCHAR_TABLE (table)->contents[c]; - } - SPLIT_CHAR (c, charset, c1, c2); - elt = XCHAR_TABLE (table)->contents[charset + 128]; - *idx = MAKE_CHAR (charset, 0, 0); - if (!SUB_CHAR_TABLE_P (elt)) - return elt; - if (c1 < 32 || NILP (XCHAR_TABLE (elt)->contents[c1])) - return XCHAR_TABLE (elt)->defalt; - elt = XCHAR_TABLE (elt)->contents[c1]; - *idx = MAKE_CHAR (charset, c1, 0); - if (!SUB_CHAR_TABLE_P (elt)) - return elt; - if (c2 < 32 || NILP (XCHAR_TABLE (elt)->contents[c2])) - return XCHAR_TABLE (elt)->defalt; - *idx = c; - return XCHAR_TABLE (elt)->contents[c2]; -} - - /* ARGSUSED */ Lisp_Object nconc2 (s1, s2) @@ -3133,6 +2493,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) USE_SAFE_ALLOCA; len = Flength (sequence); + if (CHAR_TABLE_P (sequence)) + wrong_type_argument (Qlistp, sequence); leni = XINT (len); nargs = leni + leni - 1; if (nargs < 0) return empty_unibyte_string; @@ -3169,6 +2531,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) USE_SAFE_ALLOCA; len = Flength (sequence); + if (CHAR_TABLE_P (sequence)) + wrong_type_argument (Qlistp, sequence); leni = XFASTINT (len); SAFE_ALLOCA_LISP (args, leni); @@ -3191,6 +2555,8 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) register int leni; leni = XFASTINT (Flength (sequence)); + if (CHAR_TABLE_P (sequence)) + wrong_type_argument (Qlistp, sequence); mapcar1 (leni, 0, function, sequence); return sequence; @@ -3987,7 +3353,9 @@ base64_encode_1 (from, to, length, line_break, multibyte) if (multibyte) { c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); - if (c >= 256) + if (CHAR_BYTE8_P (c)) + c = CHAR_TO_BYTE8 (c); + else if (c >= 256) return -1; i += bytes; } @@ -4025,7 +3393,9 @@ base64_encode_1 (from, to, length, line_break, multibyte) if (multibyte) { c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); - if (c >= 256) + if (CHAR_BYTE8_P (c)) + c = CHAR_TO_BYTE8 (c); + else if (c >= 256) return -1; i += bytes; } @@ -4047,7 +3417,9 @@ base64_encode_1 (from, to, length, line_break, multibyte) if (multibyte) { c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes); - if (c >= 256) + if (CHAR_BYTE8_P (c)) + c = CHAR_TO_BYTE8 (c); + else if (c >= 256) return -1; i += bytes; } @@ -4197,8 +3569,8 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) value |= base64_char_to_value[c] << 12; c = (unsigned char) (value >> 16); - if (multibyte) - e += CHAR_STRING (c, e); + if (multibyte && c >= 128) + e += BYTE8_STRING (c, e); else *e++ = c; nchars++; @@ -4221,8 +3593,8 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) value |= base64_char_to_value[c] << 6; c = (unsigned char) (0xff & value >> 8); - if (multibyte) - e += CHAR_STRING (c, e); + if (multibyte && c >= 128) + e += BYTE8_STRING (c, e); else *e++ = c; nchars++; @@ -4239,8 +3611,8 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) value |= base64_char_to_value[c]; c = (unsigned char) (0xff & value); - if (multibyte) - e += CHAR_STRING (c, e); + if (multibyte && c >= 128) + e += BYTE8_STRING (c, e); else *e++ = c; nchars++; @@ -4462,7 +3834,7 @@ hashfn_eq (h, key) struct Lisp_Hash_Table *h; Lisp_Object key; { - unsigned hash = XUINT (key) ^ XGCTYPE (key); + unsigned hash = XUINT (key) ^ XTYPE (key); xassert ((hash & ~INTMASK) == 0); return hash; } @@ -4481,7 +3853,7 @@ hashfn_eql (h, key) if (FLOATP (key)) hash = sxhash (key, 0); else - hash = XUINT (key) ^ XGCTYPE (key); + hash = XUINT (key) ^ XTYPE (key); xassert ((hash & ~INTMASK) == 0); return hash; } @@ -4902,7 +4274,7 @@ sweep_weak_table (h, remove_entries_p) /* Follow collision chain, removing entries that don't survive this garbage collection. */ prev = Qnil; - for (idx = HASH_INDEX (h, bucket); !GC_NILP (idx); idx = next) + for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next) { int i = XFASTINT (idx); int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i)); @@ -4927,7 +4299,7 @@ sweep_weak_table (h, remove_entries_p) if (remove_p) { /* Take out of collision chain. */ - if (GC_NILP (prev)) + if (NILP (prev)) HASH_INDEX (h, bucket) = next; else HASH_NEXT (h, XFASTINT (prev)) = next; @@ -4973,7 +4345,7 @@ sweep_weak_table (h, remove_entries_p) /* Remove elements from weak hash tables that don't survive the current garbage collection. Remove weak tables that don't survive - from weak_hash_tables. Called from gc_sweep. */ + from Vweak_hash_tables. Called from gc_sweep. */ void sweep_weak_hash_tables () @@ -5508,7 +4880,6 @@ including negative integers. */) ************************************************************************/ #include "md5.h" -#include "coding.h" DEFUN ("md5", Fmd5, Smd5, 1, 5, 0, doc: /* Return MD5 message digest of OBJECT, a buffer or string. @@ -5559,7 +4930,7 @@ guesswork fails. Normally, an error is signaled in such case. */) if (STRING_MULTIBYTE (object)) /* use default, we can't guess correct value */ - coding_system = find_symbol_value (XCAR (Vcoding_category_list)); + coding_system = preferred_coding_system (); else coding_system = Qraw_text; } @@ -5575,7 +4946,7 @@ guesswork fails. Normally, an error is signaled in such case. */) } if (STRING_MULTIBYTE (object)) - object = code_convert_string1 (object, coding_system, Qnil, 1); + object = code_convert_string (object, coding_system, Qnil, 1, 0, 1); size = SCHARS (object); size_byte = SBYTES (object); @@ -5717,7 +5088,7 @@ guesswork fails. Normally, an error is signaled in such case. */) specpdl_ptr--; if (STRING_MULTIBYTE (object)) - object = code_convert_string1 (object, coding_system, Qnil, 1); + object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); } md5_buffer (SDATA (object) + start_byte, @@ -5880,16 +5251,6 @@ used if both `use-dialog-box' and this variable are non-nil. */); defsubr (&Sequal_including_properties); defsubr (&Sfillarray); defsubr (&Sclear_string); - defsubr (&Schar_table_subtype); - defsubr (&Schar_table_parent); - defsubr (&Sset_char_table_parent); - defsubr (&Schar_table_extra_slot); - defsubr (&Sset_char_table_extra_slot); - defsubr (&Schar_table_range); - defsubr (&Sset_char_table_range); - defsubr (&Sset_char_table_default); - defsubr (&Soptimize_char_table); - defsubr (&Smap_char_table); defsubr (&Snconc); defsubr (&Smapcar); defsubr (&Smapc); diff --git a/src/font.c b/src/font.c new file mode 100644 index 00000000000..8347a0d5b23 --- /dev/null +++ b/src/font.c @@ -0,0 +1,4168 @@ +/* font.c -- "Font" primitives. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> +#include <stdlib.h> +#include <ctype.h> +#ifdef HAVE_M17N_FLT +#include <m17n-flt.h> +#endif + +#include "lisp.h" +#include "buffer.h" +#include "frame.h" +#include "window.h" +#include "dispextern.h" +#include "charset.h" +#include "character.h" +#include "composite.h" +#include "fontset.h" +#include "font.h" + +#ifndef FONT_DEBUG +#define FONT_DEBUG +#endif + +#ifdef FONT_DEBUG +#undef xassert +#define xassert(X) do {if (!(X)) abort ();} while (0) +#else +#define xassert(X) (void) 0 +#endif + +int enable_font_backend; + +Lisp_Object Qopentype; + +/* Important character set symbols. */ +Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip; + +/* Like CHECK_FONT_SPEC but also validate properties of the font-spec, + and set X to the validated result. */ + +#define CHECK_VALIDATE_FONT_SPEC(x) \ + do { \ + if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \ + x = font_prop_validate (x); \ + } while (0) + +/* Number of pt per inch (from the TeXbook). */ +#define PT_PER_INCH 72.27 + +/* Return a pixel size (integer) corresponding to POINT size (double) + on resolution DPI. */ +#define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5) + +/* Return a point size (double) corresponding to POINT size (integer) + on resolution DPI. */ +#define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5) + +/* Special string of zero length. It is used to specify a NULL name + in a font properties (e.g. adstyle). We don't use the symbol of + NULL name because it's confusing (Lisp printer prints nothing for + it). */ +Lisp_Object null_string; + +/* Special vector of zero length. This is repeatedly used by (struct + font_driver *)->list when a specified font is not found. */ +Lisp_Object null_vector; + +/* Vector of 3 elements. Each element is an alist for one of font + style properties (weight, slant, width). Each alist contains a + mapping between symbolic property values (e.g. `medium' for weight) + and numeric property values (e.g. 100). So, it looks like this: + [((thin . 0) ... (heavy . 210)) + ((ro . 0) ... (ot . 210)) + ((ultracondensed . 50) ... (wide . 200))] */ +static Lisp_Object font_style_table; + +/* Alist of font family vs the corresponding aliases. + Each element has this form: + (FAMILY ALIAS1 ALIAS2 ...) */ + +static Lisp_Object font_family_alist; + +/* Symbols representing keys of normal font properties. */ +extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname; +Lisp_Object QCfoundry, QCadstyle, QCregistry, QCextra; +/* Symbols representing keys of font extra info. */ +Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClanguage, QCscript; +Lisp_Object QCantialias; +/* Symbols representing values of font spacing property. */ +Lisp_Object Qc, Qm, Qp, Qd; + +/* Alist of font registry symbol and the corresponding charsets + information. The information is retrieved from + Vfont_encoding_alist on demand. + + Eash element has the form: + (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID)) + or + (REGISTRY . nil) + + In the former form, ENCODING-CHARSET-ID is an ID of a charset that + encodes a character code to a glyph code of a font, and + REPERTORY-CHARSET-ID is an ID of a charset that tells if a + character is supported by a font. + + The latter form means that the information for REGISTRY couldn't be + retrieved. */ +static Lisp_Object font_charset_alist; + +/* List of all font drivers. Each font-backend (XXXfont.c) calls + register_font_driver in syms_of_XXXfont to register its font-driver + here. */ +static struct font_driver_list *font_driver_list; + +static int font_pixel_size P_ ((FRAME_PTR f, Lisp_Object)); +static Lisp_Object prop_name_to_numeric P_ ((enum font_property_index, + Lisp_Object)); +static Lisp_Object prop_numeric_to_name P_ ((enum font_property_index, int)); +static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int)); +static void build_font_family_alist P_ ((void)); + +/* Number of registered font drivers. */ +static int num_font_drivers; + +/* Return a pixel size of font-spec SPEC on frame F. */ + +static int +font_pixel_size (f, spec) + FRAME_PTR f; + Lisp_Object spec; +{ + Lisp_Object size = AREF (spec, FONT_SIZE_INDEX); + double point_size; + int pixel_size, dpi; + Lisp_Object extra, val; + + if (INTEGERP (size)) + return XINT (size); + if (NILP (size)) + return 0; + point_size = XFLOAT_DATA (size); + extra = AREF (spec, FONT_EXTRA_INDEX); + val = assq_no_quit (QCdpi, extra); + if (CONSP (val)) + { + if (INTEGERP (XCDR (val))) + dpi = XINT (XCDR (val)); + else + dpi = XFLOAT_DATA (XCDR (val)) + 0.5; + } + else + dpi = f->resy; + pixel_size = POINT_TO_PIXEL (point_size, dpi); + return pixel_size; +} + +/* Return a numeric value corresponding to PROP's NAME (symbol). If + NAME is not registered in font_style_table, return Qnil. PROP must + be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */ + +static Lisp_Object +prop_name_to_numeric (prop, name) + enum font_property_index prop; + Lisp_Object name; +{ + int table_index = prop - FONT_WEIGHT_INDEX; + Lisp_Object val; + + val = assq_no_quit (name, AREF (font_style_table, table_index)); + return (NILP (val) ? Qnil : XCDR (val)); +} + + +/* Return a name (symbol) corresponding to PROP's NUMERIC value. If + no name is registered for NUMERIC in font_style_table, return a + symbol of integer name (e.g. `123'). PROP must be one of + FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */ + +static Lisp_Object +prop_numeric_to_name (prop, numeric) + enum font_property_index prop; + int numeric; +{ + int table_index = prop - FONT_WEIGHT_INDEX; + Lisp_Object table = AREF (font_style_table, table_index); + char buf[10]; + + while (! NILP (table)) + { + if (XINT (XCDR (XCAR (table))) >= numeric) + { + if (XINT (XCDR (XCAR (table))) == numeric) + return XCAR (XCAR (table)); + else + break; + } + table = XCDR (table); + } + sprintf (buf, "%d", numeric); + return intern (buf); +} + + +/* Return a symbol whose name is STR (length LEN). If STR contains + uppercase letters, downcase them in advance. */ + +Lisp_Object +intern_downcase (str, len) + char *str; + int len; +{ + char *buf; + int i; + + for (i = 0; i < len; i++) + if (isupper (str[i])) + break; + if (i == len) + return Fintern (make_unibyte_string (str, len), Qnil); + buf = alloca (len); + if (! buf) + return Fintern (null_string, Qnil); + bcopy (str, buf, len); + for (; i < len; i++) + if (isascii (buf[i])) + buf[i] = tolower (buf[i]); + return Fintern (make_unibyte_string (buf, len), Qnil); +} + +extern Lisp_Object Vface_alternative_font_family_alist; + +/* Setup font_family_alist of the form: + ((FAMILY-SYMBOL ALIAS-SYMBOL ...) ...) + from Vface_alternative_font_family_alist of the form: + ((FAMILY-STRING ALIAS-STRING ...) ...) */ + +static void +build_font_family_alist () +{ + Lisp_Object alist = Vface_alternative_font_family_alist; + + for (; CONSP (alist); alist = XCDR (alist)) + { + Lisp_Object tail, elt; + + for (tail = XCAR (alist), elt = Qnil ; CONSP (tail); tail = XCDR (tail)) + elt = nconc2 (elt, Fcons (Fintern (XCAR (tail), Qnil), Qnil)); + font_family_alist = Fcons (elt, font_family_alist); + } +} + +extern Lisp_Object find_font_encoding P_ ((Lisp_Object)); + +/* Return encoding charset and repertory charset for REGISTRY in + ENCODING and REPERTORY correspondingly. If correct information for + REGISTRY is available, return 0. Otherwise return -1. */ + +int +font_registry_charsets (registry, encoding, repertory) + Lisp_Object registry; + struct charset **encoding, **repertory; +{ + Lisp_Object val; + int encoding_id, repertory_id; + + val = assq_no_quit (registry, font_charset_alist); + if (! NILP (val)) + { + val = XCDR (val); + if (NILP (val)) + return -1; + encoding_id = XINT (XCAR (val)); + repertory_id = XINT (XCDR (val)); + } + else + { + val = find_font_encoding (SYMBOL_NAME (registry)); + if (SYMBOLP (val) && CHARSETP (val)) + { + encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val)); + } + else if (CONSP (val)) + { + if (! CHARSETP (XCAR (val))) + goto invalid_entry; + encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val))); + if (NILP (XCDR (val))) + repertory_id = -1; + else + { + if (! CHARSETP (XCDR (val))) + goto invalid_entry; + repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val))); + } + } + else + goto invalid_entry; + val = Fcons (make_number (encoding_id), make_number (repertory_id)); + font_charset_alist + = nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil)); + } + + if (encoding) + *encoding = CHARSET_FROM_ID (encoding_id); + if (repertory) + *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL; + return 0; + + invalid_entry: + font_charset_alist + = nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil)); + return -1; +} + + +/* Font property value validaters. See the comment of + font_property_table for the meaning of the arguments. */ + +static Lisp_Object font_prop_validate_symbol P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object font_prop_validate_style P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object font_prop_validate_non_neg P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object font_prop_validate_spacing P_ ((Lisp_Object, Lisp_Object)); +static int get_font_prop_index P_ ((Lisp_Object, int)); +static Lisp_Object font_prop_validate P_ ((Lisp_Object)); + +static Lisp_Object +font_prop_validate_symbol (prop, val) + Lisp_Object prop, val; +{ + if (EQ (prop, QCotf)) + return (SYMBOLP (val) ? val : Qerror); + if (STRINGP (val)) + val = (SCHARS (val) == 0 ? null_string + : intern_downcase ((char *) SDATA (val), SBYTES (val))); + else if (SYMBOLP (val)) + { + if (SCHARS (SYMBOL_NAME (val)) == 0) + val = null_string; + } + else + val = Qerror; + return val; +} + +static Lisp_Object +font_prop_validate_style (prop, val) + Lisp_Object prop, val; +{ + if (! INTEGERP (val)) + { + if (STRINGP (val)) + val = intern_downcase ((char *) SDATA (val), SBYTES (val)); + if (! SYMBOLP (val)) + val = Qerror; + else + { + enum font_property_index prop_index + = (EQ (prop, QCweight) ? FONT_WEIGHT_INDEX + : EQ (prop, QCslant) ? FONT_SLANT_INDEX + : FONT_WIDTH_INDEX); + + val = prop_name_to_numeric (prop_index, val); + if (NILP (val)) + val = Qerror; + } + } + return val; +} + +static Lisp_Object +font_prop_validate_non_neg (prop, val) + Lisp_Object prop, val; +{ + return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0) + ? val : Qerror); +} + +static Lisp_Object +font_prop_validate_spacing (prop, val) + Lisp_Object prop, val; +{ + if (NILP (val) || (NATNUMP (val) && XINT (val) <= FONT_SPACING_CHARCELL)) + return val; + if (EQ (val, Qc)) + return make_number (FONT_SPACING_CHARCELL); + if (EQ (val, Qm)) + return make_number (FONT_SPACING_MONO); + if (EQ (val, Qp)) + return make_number (FONT_SPACING_PROPORTIONAL); + return Qerror; +} + +static Lisp_Object +font_prop_validate_otf (prop, val) + Lisp_Object prop, val; +{ + Lisp_Object tail, tmp; + int i; + + /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]]) + GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil + GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */ + if (! CONSP (val)) + return Qerror; + if (! SYMBOLP (XCAR (val))) + return Qerror; + tail = XCDR (val); + if (NILP (tail)) + return val; + if (! CONSP (tail) || ! SYMBOLP (XCAR (val))) + return Qerror; + for (i = 0; i < 2; i++) + { + tail = XCDR (tail); + if (NILP (tail)) + return val; + if (! CONSP (tail)) + return Qerror; + for (tmp = XCAR (tail); CONSP (tmp); tmp = XCDR (tmp)) + if (! SYMBOLP (XCAR (tmp))) + return Qerror; + if (! NILP (tmp)) + return Qerror; + } + return val; +} + +/* Structure of known font property keys and validater of the + values. */ +struct +{ + /* Pointer to the key symbol. */ + Lisp_Object *key; + /* Function to validate PROP's value VAL, or NULL if any value is + ok. The value is VAL or its regularized value if VAL is valid, + and Qerror if not. */ + Lisp_Object (*validater) P_ ((Lisp_Object prop, Lisp_Object val)); +} font_property_table[] = + { { &QCtype, font_prop_validate_symbol }, + { &QCfoundry, font_prop_validate_symbol }, + { &QCfamily, font_prop_validate_symbol }, + { &QCadstyle, font_prop_validate_symbol }, + { &QCregistry, font_prop_validate_symbol }, + { &QCweight, font_prop_validate_style }, + { &QCslant, font_prop_validate_style }, + { &QCwidth, font_prop_validate_style }, + { &QCsize, font_prop_validate_non_neg }, + { &QClanguage, font_prop_validate_symbol }, + { &QCscript, font_prop_validate_symbol }, + { &QCdpi, font_prop_validate_non_neg }, + { &QCspacing, font_prop_validate_spacing }, + { &QCscalable, NULL }, + { &QCotf, font_prop_validate_otf }, + { &QCantialias, font_prop_validate_symbol } + }; + +/* Size (number of elements) of the above table. */ +#define FONT_PROPERTY_TABLE_SIZE \ + ((sizeof font_property_table) / (sizeof *font_property_table)) + +/* Return an index number of font property KEY or -1 if KEY is not an + already known property. Start searching font_property_table from + index FROM (which is 0 or FONT_EXTRA_INDEX). */ + +static int +get_font_prop_index (key, from) + Lisp_Object key; + int from; +{ + for (; from < FONT_PROPERTY_TABLE_SIZE; from++) + if (EQ (key, *font_property_table[from].key)) + return from; + return -1; +} + +/* Validate font properties in SPEC (vector) while updating elements + to regularized values. Signal an error if an invalid property is + found. */ + +static Lisp_Object +font_prop_validate (spec) + Lisp_Object spec; +{ + int i; + Lisp_Object prop, val, extra; + + for (i = FONT_TYPE_INDEX; i < FONT_EXTRA_INDEX; i++) + { + if (! NILP (AREF (spec, i))) + { + prop = *font_property_table[i].key; + val = (font_property_table[i].validater) (prop, AREF (spec, i)); + if (EQ (val, Qerror)) + Fsignal (Qfont, list2 (build_string ("invalid font property"), + Fcons (prop, AREF (spec, i)))); + ASET (spec, i, val); + } + } + for (extra = AREF (spec, FONT_EXTRA_INDEX); + CONSP (extra); extra = XCDR (extra)) + { + Lisp_Object elt = XCAR (extra); + + prop = XCAR (elt); + i = get_font_prop_index (prop, FONT_EXTRA_INDEX); + if (i >= 0 + && font_property_table[i].validater) + { + val = (font_property_table[i].validater) (prop, XCDR (elt)); + if (EQ (val, Qerror)) + Fsignal (Qfont, list2 (build_string ("invalid font property"), + elt)); + XSETCDR (elt, val); + } + } + return spec; +} + +/* Store VAL as a value of extra font property PROP in FONT. */ + +Lisp_Object +font_put_extra (font, prop, val) + Lisp_Object font, prop, val; +{ + Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX); + Lisp_Object slot = (NILP (extra) ? Qnil : assq_no_quit (prop, extra)); + + if (NILP (slot)) + { + extra = Fcons (Fcons (prop, val), extra); + ASET (font, FONT_EXTRA_INDEX, extra); + return val; + } + XSETCDR (slot, val); + return val; +} + + +/* Font name parser and unparser */ + +static Lisp_Object intern_font_field P_ ((char *, int)); +static int parse_matrix P_ ((char *)); +static int font_expand_wildcards P_ ((Lisp_Object *, int)); +static int font_parse_name P_ ((char *, Lisp_Object)); + +/* An enumerator for each field of an XLFD font name. */ +enum xlfd_field_index +{ + XLFD_FOUNDRY_INDEX, + XLFD_FAMILY_INDEX, + XLFD_WEIGHT_INDEX, + XLFD_SLANT_INDEX, + XLFD_SWIDTH_INDEX, + XLFD_ADSTYLE_INDEX, + XLFD_PIXEL_INDEX, + XLFD_POINT_INDEX, + XLFD_RESX_INDEX, + XLFD_RESY_INDEX, + XLFD_SPACING_INDEX, + XLFD_AVGWIDTH_INDEX, + XLFD_REGISTRY_INDEX, + XLFD_ENCODING_INDEX, + XLFD_LAST_INDEX +}; + +/* An enumerator for mask bit corresponding to each XLFD field. */ +enum xlfd_field_mask +{ + XLFD_FOUNDRY_MASK = 0x0001, + XLFD_FAMILY_MASK = 0x0002, + XLFD_WEIGHT_MASK = 0x0004, + XLFD_SLANT_MASK = 0x0008, + XLFD_SWIDTH_MASK = 0x0010, + XLFD_ADSTYLE_MASK = 0x0020, + XLFD_PIXEL_MASK = 0x0040, + XLFD_POINT_MASK = 0x0080, + XLFD_RESX_MASK = 0x0100, + XLFD_RESY_MASK = 0x0200, + XLFD_SPACING_MASK = 0x0400, + XLFD_AVGWIDTH_MASK = 0x0800, + XLFD_REGISTRY_MASK = 0x1000, + XLFD_ENCODING_MASK = 0x2000 +}; + + +/* Return a Lispy value of a XLFD font field at STR and LEN bytes. + If LEN is zero, it returns `null_string'. + If STR is "*", it returns nil. + If all characters in STR are digits, it returns an integer. + Otherwise, it returns a symbol interned from downcased STR. */ + +static Lisp_Object +intern_font_field (str, len) + char *str; + int len; +{ + int i; + + if (len == 0) + return null_string; + if (*str == '*' && len == 1) + return Qnil; + if (isdigit (*str)) + { + for (i = 1; i < len; i++) + if (! isdigit (str[i])) + break; + if (i == len) + return make_number (atoi (str)); + } + return intern_downcase (str, len); +} + +/* Parse P pointing the pixel/point size field of the form + `[A B C D]' which specifies a transformation matrix: + + A B 0 + C D 0 + 0 0 1 + + by which all glyphs of the font are transformed. The spec says + that scalar value N for the pixel/point size is equivalent to: + A = N * resx/resy, B = C = 0, D = N. + + Return the scalar value N if the form is valid. Otherwise return + -1. */ + +static int +parse_matrix (p) + char *p; +{ + double matrix[4]; + char *end; + int i; + + for (i = 0, p++; i < 4 && *p && *p != ']'; i++) + { + if (*p == '~') + matrix[i] = - strtod (p + 1, &end); + else + matrix[i] = strtod (p, &end); + p = end; + } + return (i == 4 ? (int) matrix[3] : -1); +} + +/* Expand a wildcard field in FIELD (the first N fields are filled) to + multiple fields to fill in all 14 XLFD fields while restring a + field position by its contents. */ + +static int +font_expand_wildcards (field, n) + Lisp_Object field[XLFD_LAST_INDEX]; + int n; +{ + /* Copy of FIELD. */ + Lisp_Object tmp[XLFD_LAST_INDEX]; + /* Array of information about where this element can go. Nth + element is for Nth element of FIELD. */ + struct { + /* Minimum possible field. */ + int from; + /* Maxinum possible field. */ + int to; + /* Bit mask of possible field. Nth bit corresponds to Nth field. */ + int mask; + } range[XLFD_LAST_INDEX]; + int i, j; + int range_from, range_to; + unsigned range_mask; + +#define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \ + | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK) +#define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK) +#define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \ + | XLFD_AVGWIDTH_MASK) +#define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK) + + /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th + field. The value is shifted to left one bit by one in the + following loop. */ + for (i = 0, range_mask = 0; i <= 14 - n; i++) + range_mask = (range_mask << 1) | 1; + + /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a + position-based retriction for FIELD[I]. */ + for (i = 0, range_from = 0, range_to = 14 - n; i < n; + i++, range_from++, range_to++, range_mask <<= 1) + { + Lisp_Object val = field[i]; + + tmp[i] = val; + if (NILP (val)) + { + /* Wildcard. */ + range[i].from = range_from; + range[i].to = range_to; + range[i].mask = range_mask; + } + else + { + /* The triplet FROM, TO, and MASK is a value-based + retriction for FIELD[I]. */ + int from, to; + unsigned mask; + + if (INTEGERP (val)) + { + int numeric = XINT (val); + + if (i + 1 == n) + from = to = XLFD_ENCODING_INDEX, + mask = XLFD_ENCODING_MASK; + else if (numeric == 0) + from = XLFD_PIXEL_INDEX, to = XLFD_AVGWIDTH_INDEX, + mask = XLFD_PIXEL_MASK | XLFD_LARGENUM_MASK; + else if (numeric <= 48) + from = to = XLFD_PIXEL_INDEX, + mask = XLFD_PIXEL_MASK; + else + from = XLFD_POINT_INDEX, to = XLFD_AVGWIDTH_INDEX, + mask = XLFD_LARGENUM_MASK; + } + else if (EQ (val, null_string)) + from = XLFD_FOUNDRY_INDEX, to = XLFD_ADSTYLE_INDEX, + mask = XLFD_NULL_MASK; + else if (i == 0) + from = to = XLFD_FOUNDRY_INDEX, mask = XLFD_FOUNDRY_MASK; + else if (i + 1 == n) + { + Lisp_Object name = SYMBOL_NAME (val); + + if (SDATA (name)[SBYTES (name) - 1] == '*') + from = XLFD_REGISTRY_INDEX, to = XLFD_ENCODING_INDEX, + mask = XLFD_REGENC_MASK; + else + from = to = XLFD_ENCODING_INDEX, + mask = XLFD_ENCODING_MASK; + } + else if (range_from <= XLFD_WEIGHT_INDEX + && range_to >= XLFD_WEIGHT_INDEX + && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX, val))) + from = to = XLFD_WEIGHT_INDEX, mask = XLFD_WEIGHT_MASK; + else if (range_from <= XLFD_SLANT_INDEX + && range_to >= XLFD_SLANT_INDEX + && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX, val))) + from = to = XLFD_SLANT_INDEX, mask = XLFD_SLANT_MASK; + else if (range_from <= XLFD_SWIDTH_INDEX + && range_to >= XLFD_SWIDTH_INDEX + && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX, val))) + from = to = XLFD_SWIDTH_INDEX, mask = XLFD_SWIDTH_MASK; + else + { + if (EQ (val, Qc) || EQ (val, Qm) || EQ (val, Qp) || EQ (val, Qd)) + from = to = XLFD_SPACING_INDEX, mask = XLFD_SPACING_MASK; + else + from = XLFD_FOUNDRY_INDEX, to = XLFD_ENCODING_INDEX, + mask = XLFD_SYMBOL_MASK; + } + + /* Merge position-based and value-based restrictions. */ + mask &= range_mask; + while (from < range_from) + mask &= ~(1 << from++); + while (from < 14 && ! (mask & (1 << from))) + from++; + while (to > range_to) + mask &= ~(1 << to--); + while (to >= 0 && ! (mask & (1 << to))) + to--; + if (from > to) + return -1; + range[i].from = from; + range[i].to = to; + range[i].mask = mask; + + if (from > range_from || to < range_to) + { + /* The range is narrowed by value-based restrictions. + Reflect it to the other fields. */ + + /* Following fields should be after FROM. */ + range_from = from; + /* Preceding fields should be before TO. */ + for (j = i - 1, from--, to--; j >= 0; j--, from--, to--) + { + /* Check FROM for non-wildcard field. */ + if (! NILP (tmp[j]) && range[j].from < from) + { + while (range[j].from < from) + range[j].mask &= ~(1 << range[j].from++); + while (from < 14 && ! (range[j].mask & (1 << from))) + from++; + range[j].from = from; + } + else + from = range[j].from; + if (range[j].to > to) + { + while (range[j].to > to) + range[j].mask &= ~(1 << range[j].to--); + while (to >= 0 && ! (range[j].mask & (1 << to))) + to--; + range[j].to = to; + } + else + to = range[j].to; + if (from > to) + return -1; + } + } + } + } + + /* Decide all fileds from restrictions in RANGE. */ + for (i = j = 0; i < n ; i++) + { + if (j < range[i].from) + { + if (i == 0 || ! NILP (tmp[i - 1])) + /* None of TMP[X] corresponds to Jth field. */ + return -1; + for (; j < range[i].from; j++) + field[j] = Qnil; + } + field[j++] = tmp[i]; + } + if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX) + return -1; + for (; j < XLFD_LAST_INDEX; j++) + field[j] = Qnil; + if (INTEGERP (field[XLFD_ENCODING_INDEX])) + field[XLFD_ENCODING_INDEX] + = Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil); + return 0; +} + +/* Parse NAME (null terminated) as XLFD and store information in FONT + (font-spec or font-entity). Size property of FONT is set as + follows: + specified XLFD fields FONT property + --------------------- ------------- + PIXEL_SIZE PIXEL_SIZE (Lisp integer) + POINT_SIZE and RESY calculated pixel size (Lisp integer) + POINT_SIZE POINT_SIZE/10 (Lisp float) + + If NAME is successfully parsed, return 0. Otherwise return -1. + + FONT is usually a font-spec, but when this function is called from + X font backend driver, it is a font-entity. In that case, NAME is + a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a + symbol RESX-RESY-SPACING-AVGWIDTH. +*/ + +int +font_parse_xlfd (name, font) + char *name; + Lisp_Object font; +{ + int len = strlen (name); + int i, j; + Lisp_Object dpi, spacing; + int avgwidth; + char *f[XLFD_LAST_INDEX + 1]; + Lisp_Object val; + char *p; + + if (len > 255) + /* Maximum XLFD name length is 255. */ + return -1; + /* Accept "*-.." as a fully specified XLFD. */ + if (name[0] == '*' && name[1] == '-') + i = 1, f[XLFD_FOUNDRY_INDEX] = name; + else + i = 0; + for (p = name + i; *p; p++) + if (*p == '-' && i < XLFD_LAST_INDEX) + f[i++] = p + 1; + f[i] = p; + + dpi = spacing = Qnil; + avgwidth = -1; + + if (i == XLFD_LAST_INDEX) + { + int pixel_size; + + /* Fully specified XLFD. */ + for (i = 0, j = FONT_FOUNDRY_INDEX; i < XLFD_WEIGHT_INDEX; i++, j++) + { + val = intern_font_field (f[i], f[i + 1] - 1 - f[i]); + if (! NILP (val)) + ASET (font, j, val); + } + for (j = FONT_WEIGHT_INDEX; i < XLFD_ADSTYLE_INDEX; i++, j++) + { + val = intern_font_field (f[i], f[i + 1] - 1 - f[i]); + if (! NILP (val)) + { + Lisp_Object numeric = prop_name_to_numeric (j, val); + + if (INTEGERP (numeric)) + val = numeric; + ASET (font, j, val); + } + } + val = intern_font_field (f[i], f[i + 1] - 1 - f[i]); + if (! NILP (val)) + ASET (font, FONT_ADSTYLE_INDEX, val); + i = XLFD_REGISTRY_INDEX; + val = intern_font_field (f[i], f[i + 2] - f[i]); + if (! NILP (val)) + ASET (font, FONT_REGISTRY_INDEX, val); + + p = f[XLFD_PIXEL_INDEX]; + if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0) + ASET (font, FONT_SIZE_INDEX, make_number (pixel_size)); + else + { + i = XLFD_PIXEL_INDEX; + val = intern_font_field (f[i], f[i + 1] - 1 - f[i]); + if (! NILP (val)) + ASET (font, FONT_SIZE_INDEX, val); + else + { + double point_size = -1; + + xassert (FONT_SPEC_P (font)); + p = f[XLFD_POINT_INDEX]; + if (*p == '[') + point_size = parse_matrix (p); + else if (isdigit (*p)) + point_size = atoi (p), point_size /= 10; + if (point_size >= 0) + ASET (font, FONT_SIZE_INDEX, make_float (point_size)); + else + { + i = XLFD_PIXEL_INDEX; + val = intern_font_field (f[i], f[i + 1] - 1 - f[i]); + if (! NILP (val)) + ASET (font, FONT_SIZE_INDEX, val); + } + } + } + + /* Parse RESX, RESY, SPACING, and AVGWIDTH. */ + if (FONT_ENTITY_P (font)) + { + i = XLFD_RESX_INDEX; + ASET (font, FONT_EXTRA_INDEX, + intern_font_field (f[i], f[XLFD_REGISTRY_INDEX] - 1 - f[i])); + return 0; + } + + /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set + in FONT_EXTRA_INDEX later. */ + i = XLFD_RESX_INDEX; + dpi = intern_font_field (f[i], f[i + 1] - 1 - f[i]); + i = XLFD_SPACING_INDEX; + spacing = intern_font_field (f[i], f[i + 1] - 1 - f[i]); + p = f[XLFD_AVGWIDTH_INDEX]; + if (*p == '~') + p++; + if (isdigit (*p)) + avgwidth = atoi (p); + } + else + { + int wild_card_found = 0; + Lisp_Object prop[XLFD_LAST_INDEX]; + + for (j = 0; j < i; j++) + { + if (*f[j] == '*') + { + if (f[j][1] && f[j][1] != '-') + return -1; + prop[j] = Qnil; + wild_card_found = 1; + } + else if (isdigit (*f[j])) + { + for (p = f[j] + 1; isdigit (*p); p++); + if (*p && *p != '-') + prop[j] = intern_downcase (f[j], p - f[j]); + else + prop[j] = make_number (atoi (f[j])); + } + else if (j + 1 < i) + prop[j] = intern_font_field (f[j], f[j + 1] - 1 - f[j]); + else + prop[j] = intern_font_field (f[j], f[i] - f[j]); + } + if (! wild_card_found) + return -1; + if (font_expand_wildcards (prop, i) < 0) + return -1; + + for (i = 0, j = FONT_FOUNDRY_INDEX; i < XLFD_WEIGHT_INDEX; i++, j++) + if (! NILP (prop[i])) + ASET (font, j, prop[i]); + for (j = FONT_WEIGHT_INDEX; i < XLFD_ADSTYLE_INDEX; i++, j++) + if (! NILP (prop[i])) + ASET (font, j, prop[i]); + if (! NILP (prop[XLFD_ADSTYLE_INDEX])) + ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]); + val = prop[XLFD_REGISTRY_INDEX]; + if (NILP (val)) + { + val = prop[XLFD_ENCODING_INDEX]; + if (! NILP (val)) + val = Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val)), + Qnil); + } + else if (NILP (prop[XLFD_ENCODING_INDEX])) + val = Fintern (concat2 (SYMBOL_NAME (val), build_string ("-*")), + Qnil); + else + val = Fintern (concat3 (SYMBOL_NAME (val), build_string ("-"), + SYMBOL_NAME (prop[XLFD_ENCODING_INDEX])), + Qnil); + if (! NILP (val)) + ASET (font, FONT_REGISTRY_INDEX, val); + + if (INTEGERP (prop[XLFD_PIXEL_INDEX])) + ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]); + else if (INTEGERP (prop[XLFD_POINT_INDEX])) + { + double point_size = XINT (prop[XLFD_POINT_INDEX]); + + ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10)); + } + + dpi = prop[XLFD_RESX_INDEX]; + spacing = prop[XLFD_SPACING_INDEX]; + if (INTEGERP (prop[XLFD_AVGWIDTH_INDEX])) + avgwidth = XINT (prop[XLFD_AVGWIDTH_INDEX]); + } + + if (! NILP (dpi)) + font_put_extra (font, QCdpi, dpi); + if (! NILP (spacing)) + font_put_extra (font, QCspacing, spacing); + if (avgwidth >= 0) + font_put_extra (font, QCscalable, avgwidth == 0 ? Qt : Qnil); + + return 0; +} + +/* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES + length), and return the name length. If FONT_SIZE_INDEX of FONT is + 0, use PIXEL_SIZE instead. */ + +int +font_unparse_xlfd (font, pixel_size, name, nbytes) + Lisp_Object font; + int pixel_size; + char *name; + int nbytes; +{ + char *f[XLFD_REGISTRY_INDEX + 1]; + Lisp_Object val; + int i, j, len = 0; + + xassert (FONTP (font)); + + for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; + i++, j++) + { + if (i == FONT_ADSTYLE_INDEX) + j = XLFD_ADSTYLE_INDEX; + else if (i == FONT_REGISTRY_INDEX) + j = XLFD_REGISTRY_INDEX; + val = AREF (font, i); + if (NILP (val)) + { + if (j == XLFD_REGISTRY_INDEX) + f[j] = "*-*", len += 4; + else + f[j] = "*", len += 2; + } + else + { + if (SYMBOLP (val)) + val = SYMBOL_NAME (val); + if (j == XLFD_REGISTRY_INDEX + && ! strchr ((char *) SDATA (val), '-')) + { + /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */ + if (SDATA (val)[SBYTES (val) - 1] == '*') + { + f[j] = alloca (SBYTES (val) + 3); + sprintf (f[j], "%s-*", SDATA (val)); + len += SBYTES (val) + 3; + } + else + { + f[j] = alloca (SBYTES (val) + 4); + sprintf (f[j], "%s*-*", SDATA (val)); + len += SBYTES (val) + 4; + } + } + else + f[j] = (char *) SDATA (val), len += SBYTES (val) + 1; + } + } + + for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; + i++, j++) + { + val = AREF (font, i); + if (NILP (val)) + f[j] = "*", len += 2; + else + { + if (INTEGERP (val)) + val = prop_numeric_to_name (i, XINT (val)); + if (SYMBOLP (val)) + val = SYMBOL_NAME (val); + xassert (STRINGP (val)); + f[j] = (char *) SDATA (val), len += SBYTES (val) + 1; + } + } + + val = AREF (font, FONT_SIZE_INDEX); + xassert (NUMBERP (val) || NILP (val)); + if (INTEGERP (val)) + { + f[XLFD_PIXEL_INDEX] = alloca (22); + i = XINT (val); + if (i > 0) + len += sprintf (f[XLFD_PIXEL_INDEX], "%d-*", i) + 1; + else if (pixel_size > 0) + len += sprintf (f[XLFD_PIXEL_INDEX], "%d-*", pixel_size) + 1; + f[XLFD_PIXEL_INDEX] = "*-*", len += 4; + } + else if (FLOATP (val)) + { + f[XLFD_PIXEL_INDEX] = alloca (12); + i = XFLOAT_DATA (val) * 10; + len += sprintf (f[XLFD_PIXEL_INDEX], "*-%d", i) + 1; + } + else + f[XLFD_PIXEL_INDEX] = "*-*", len += 4; + + val = AREF (font, FONT_EXTRA_INDEX); + + if (FONT_ENTITY_P (font) + && EQ (AREF (font, FONT_TYPE_INDEX), Qx)) + { + /* Setup names for RESX-RESY-SPACING-AVWIDTH. */ + if (SYMBOLP (val) && ! NILP (val)) + { + val = SYMBOL_NAME (val); + f[XLFD_RESX_INDEX] = (char *) SDATA (val), len += SBYTES (val) + 1; + } + else + f[XLFD_RESX_INDEX] = "*-*-*-*", len += 6; + } + else + { + Lisp_Object dpi = assq_no_quit (QCdpi, val); + Lisp_Object spacing = assq_no_quit (QCspacing, val); + Lisp_Object scalable = assq_no_quit (QCscalable, val); + + if (CONSP (dpi) || CONSP (spacing) || CONSP (scalable)) + { + char *str = alloca (24); + int this_len; + + if (CONSP (dpi) && INTEGERP (XCDR (dpi))) + this_len = sprintf (str, "%d-%d", + XINT (XCDR (dpi)), XINT (XCDR (dpi))); + else + this_len = sprintf (str, "*-*"); + if (CONSP (spacing) && ! NILP (XCDR (spacing))) + { + val = XCDR (spacing); + if (INTEGERP (val)) + { + if (XINT (val) < FONT_SPACING_MONO) + val = Qp; + else if (XINT (val) < FONT_SPACING_CHARCELL) + val = Qm; + else + val = Qc; + } + xassert (SYMBOLP (val)); + this_len += sprintf (str + this_len, "-%c", + SDATA (SYMBOL_NAME (val))[0]); + } + else + this_len += sprintf (str + this_len, "-*"); + if (CONSP (scalable) && ! NILP (XCDR (spacing))) + this_len += sprintf (str + this_len, "-0"); + else + this_len += sprintf (str + this_len, "-*"); + f[XLFD_RESX_INDEX] = str; + len += this_len; + } + else + f[XLFD_RESX_INDEX] = "*-*-*-*", len += 8; + } + + len++; /* for terminating '\0'. */ + if (len >= nbytes) + return -1; + return sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-%s-%s", + f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX], + f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX], + f[XLFD_SWIDTH_INDEX], + f[XLFD_ADSTYLE_INDEX], f[XLFD_PIXEL_INDEX], + f[XLFD_RESX_INDEX], f[XLFD_REGISTRY_INDEX]); +} + +/* Parse NAME (null terminated) as Fonconfig's name format and store + information in FONT (font-spec or font-entity). If NAME is + successfully parsed, return 0. Otherwise return -1. */ + +int +font_parse_fcname (name, font) + char *name; + Lisp_Object font; +{ + char *p0, *p1; + int len = strlen (name); + char *copy; + int weight_set = 0; + int slant_set = 0; + + if (len == 0) + return -1; + /* It is assured that (name[0] && name[0] != '-'). */ + if (name[0] == ':') + p0 = name; + else + { + Lisp_Object family; + double point_size; + + for (p0 = name + 1; *p0 && (*p0 != '-' && *p0 != ':'); p0++) + if (*p0 == '\\' && p0[1]) + p0++; + family = intern_font_field (name, p0 - name); + if (*p0 == '-') + { + if (! isdigit (p0[1])) + return -1; + point_size = strtod (p0 + 1, &p1); + if (*p1 && *p1 != ':') + return -1; + ASET (font, FONT_SIZE_INDEX, make_float (point_size)); + p0 = p1; + } + ASET (font, FONT_FAMILY_INDEX, family); + } + + len -= p0 - name; + copy = alloca (len + 1); + if (! copy) + return -1; + name = copy; + + /* Now parse ":KEY=VAL" patterns. Store known keys and values in + extra, copy unknown ones to COPY. */ + while (*p0) + { + Lisp_Object key, val; + int prop; + + for (p1 = p0 + 1; *p1 && *p1 != '=' && *p1 != ':'; p1++); + if (*p1 != '=') + { + /* Must be an enumerated value. */ + val = intern_font_field (p0 + 1, p1 - p0 - 1); + if (memcmp (p0 + 1, "light", 5) == 0 + || memcmp (p0 + 1, "medium", 6) == 0 + || memcmp (p0 + 1, "demibold", 8) == 0 + || memcmp (p0 + 1, "bold", 4) == 0 + || memcmp (p0 + 1, "black", 5) == 0) + { + ASET (font, FONT_WEIGHT_INDEX, val); + weight_set = 1; + } + else if (memcmp (p0 + 1, "roman", 5) == 0 + || memcmp (p0 + 1, "italic", 6) == 0 + || memcmp (p0 + 1, "oblique", 7) == 0) + { + ASET (font, FONT_SLANT_INDEX, val); + slant_set = 1; + } + else if (memcmp (p0 + 1, "charcell", 8) == 0 + || memcmp (p0 + 1, "mono", 4) == 0 + || memcmp (p0 + 1, "proportional", 12) == 0) + { + font_put_extra (font, QCspacing, + (p0[1] == 'c' ? Qc : p0[1] == 'm' ? Qm : Qp)); + } + else + { + /* unknown key */ + bcopy (p0, copy, p1 - p0); + copy += p1 - p0; + } + } + else + { + if (memcmp (p0 + 1, "pixelsize=", 10) == 0) + prop = FONT_SIZE_INDEX; + else + { + key = intern_font_field (p0, p1 - p0); + prop = get_font_prop_index (key, 0); + } + p0 = p1 + 1; + for (p1 = p0; *p1 && *p1 != ':'; p1++); + val = intern_font_field (p0, p1 - p0); + if (! NILP (val)) + { + if (prop >= 0 && prop < FONT_EXTRA_INDEX) + { + if (prop == FONT_WEIGHT_INDEX) + weight_set = 1; + else if (prop == FONT_SLANT_INDEX) + slant_set = 1; + + ASET (font, prop, val); + } + else + font_put_extra (font, key, val); + } + } + p0 = p1; + } + + if (!weight_set) + ASET (font, FONT_WEIGHT_INDEX, build_string ("normal")); + if (!slant_set) + ASET (font, FONT_SLANT_INDEX, build_string ("normal")); + + return 0; +} + +/* Store fontconfig's font name of FONT (font-spec or font-entity) in + NAME (NBYTES length), and return the name length. If + FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */ + +int +font_unparse_fcname (font, pixel_size, name, nbytes) + Lisp_Object font; + int pixel_size; + char *name; + int nbytes; +{ + Lisp_Object val; + int point_size; + int dpi, spacing, scalable; + int i, len = 1; + char *p; + Lisp_Object styles[3]; + char *style_names[3] = { "weight", "slant", "width" }; + + val = AREF (font, FONT_FAMILY_INDEX); + if (SYMBOLP (val) && ! NILP (val)) + len += SBYTES (SYMBOL_NAME (val)); + + val = AREF (font, FONT_SIZE_INDEX); + if (INTEGERP (val)) + { + if (XINT (val) != 0) + pixel_size = XINT (val); + point_size = -1; + len += 21; /* for ":pixelsize=NUM" */ + } + else if (FLOATP (val)) + { + pixel_size = -1; + point_size = (int) XFLOAT_DATA (val); + len += 11; /* for "-NUM" */ + } + + val = AREF (font, FONT_FOUNDRY_INDEX); + if (SYMBOLP (val) && ! NILP (val)) + /* ":foundry=NAME" */ + len += 9 + SBYTES (SYMBOL_NAME (val)); + + for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++) + { + val = AREF (font, i); + if (INTEGERP (val)) + { + val = prop_numeric_to_name (i, XINT (val)); + len += (strlen (style_names[i - FONT_WEIGHT_INDEX]) + + 2 + SBYTES (SYMBOL_NAME (val))); /* :xxx=NAME */ + } + styles[i - FONT_WEIGHT_INDEX] = val; + } + + val = AREF (font, FONT_EXTRA_INDEX); + if (FONT_ENTITY_P (font) + && EQ (AREF (font, FONT_TYPE_INDEX), Qx)) + { + char *p; + + /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */ + p = (char *) SDATA (SYMBOL_NAME (val)); + dpi = atoi (p); + for (p++; *p != '-'; p++); /* skip RESX */ + for (p++; *p != '-'; p++); /* skip RESY */ + spacing = (*p == 'c' ? FONT_SPACING_CHARCELL + : *p == 'm' ? FONT_SPACING_MONO + : FONT_SPACING_PROPORTIONAL); + for (p++; *p != '-'; p++); /* skip SPACING */ + scalable = (atoi (p) == 0); + /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */ + len += 42; + } + else + { + Lisp_Object elt; + + dpi = spacing = scalable = -1; + elt = assq_no_quit (QCdpi, val); + if (CONSP (elt)) + dpi = XINT (XCDR (elt)), len += 15; /* for ":dpi=NUM" */ + elt = assq_no_quit (QCspacing, val); + if (CONSP (elt)) + spacing = XINT (XCDR (elt)), len += 12; /* for ":spacing=100" */ + elt = assq_no_quit (QCscalable, val); + if (CONSP (elt)) + scalable = ! NILP (XCDR (elt)), len += 15; /* for ":scalable=False" */ + } + + if (len > nbytes) + return -1; + p = name; + if (! NILP (AREF (font, FONT_FAMILY_INDEX))) + p += sprintf(p, "%s", + SDATA (SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX)))); + if (point_size > 0) + { + if (p == name) + p += sprintf (p, "%d", point_size); + else + p += sprintf (p, "-%d", point_size); + } + else if (pixel_size > 0) + p += sprintf (p, ":pixelsize=%d", pixel_size); + if (SYMBOLP (AREF (font, FONT_FOUNDRY_INDEX)) + && ! NILP (AREF (font, FONT_FOUNDRY_INDEX))) + p += sprintf (p, ":foundry=%s", + SDATA (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX)))); + for (i = 0; i < 3; i++) + if (SYMBOLP (styles[i]) && ! NILP (styles [i])) + p += sprintf (p, ":%s=%s", style_names[i], + SDATA (SYMBOL_NAME (styles [i]))); + if (dpi >= 0) + p += sprintf (p, ":dpi=%d", dpi); + if (spacing >= 0) + p += sprintf (p, ":spacing=%d", spacing); + if (scalable > 0) + p += sprintf (p, ":scalable=True"); + else if (scalable == 0) + p += sprintf (p, ":scalable=False"); + return (p - name); +} + +/* Parse NAME (null terminated) and store information in FONT + (font-spec or font-entity). If NAME is successfully parsed, return + 0. Otherwise return -1. + + If NAME is XLFD and FONT is a font-entity, store + RESX-RESY-SPACING-AVWIDTH information as a symbol in + FONT_EXTRA_INDEX. */ + +static int +font_parse_name (name, font) + char *name; + Lisp_Object font; +{ + if (name[0] == '-' || index (name, '*')) + return font_parse_xlfd (name, font); + return font_parse_fcname (name, font); +} + +/* Merge old style font specification (either a font name NAME or a + combination of a family name FAMILY and a registry name REGISTRY + into the font specification SPEC. */ + +void +font_merge_old_spec (name, family, registry, spec) + Lisp_Object name, family, registry, spec; +{ + if (STRINGP (name)) + { + if (font_parse_xlfd ((char *) SDATA (name), spec) < 0) + { + Lisp_Object extra = Fcons (Fcons (QCname, name), Qnil); + + ASET (spec, FONT_EXTRA_INDEX, extra); + } + } + else + { + if (! NILP (family)) + { + int len; + char *p0, *p1; + + xassert (STRINGP (family)); + len = SBYTES (family); + p0 = (char *) SDATA (family); + p1 = index (p0, '-'); + if (p1) + { + if ((*p0 != '*' || p1 - p0 > 1) + && NILP (AREF (spec, FONT_FOUNDRY_INDEX))) + ASET (spec, FONT_FOUNDRY_INDEX, + intern_downcase (p0, p1 - p0)); + if (NILP (AREF (spec, FONT_FAMILY_INDEX))) + ASET (spec, FONT_FAMILY_INDEX, + intern_downcase (p1 + 1, len - (p1 + 1 - p0))); + } + else if (NILP (AREF (spec, FONT_FAMILY_INDEX))) + ASET (spec, FONT_FAMILY_INDEX, intern_downcase (p0, len)); + } + if (! NILP (registry) + && NILP (AREF (spec, FONT_REGISTRY_INDEX))) + ASET (spec, FONT_REGISTRY_INDEX, + intern_downcase ((char *) SDATA (registry), SBYTES (registry))); + } +} + + +/* This part (through the next ^L) is still experimental and never + tested. We may drastically change codes. */ + +/* OTF handler */ + +#define LGSTRING_HEADER_SIZE 6 +#define LGSTRING_GLYPH_SIZE 8 + +static int +check_gstring (gstring) + Lisp_Object gstring; +{ + Lisp_Object val; + int i, j; + + CHECK_VECTOR (gstring); + val = AREF (gstring, 0); + CHECK_VECTOR (val); + if (ASIZE (val) < LGSTRING_HEADER_SIZE) + goto err; + CHECK_FONT_OBJECT (LGSTRING_FONT (gstring)); + if (! NILP (LGSTRING_LBEARING (gstring))) + CHECK_NUMBER (LGSTRING_LBEARING (gstring)); + if (! NILP (LGSTRING_RBEARING (gstring))) + CHECK_NUMBER (LGSTRING_RBEARING (gstring)); + if (! NILP (LGSTRING_WIDTH (gstring))) + CHECK_NATNUM (LGSTRING_WIDTH (gstring)); + if (! NILP (LGSTRING_ASCENT (gstring))) + CHECK_NUMBER (LGSTRING_ASCENT (gstring)); + if (! NILP (LGSTRING_DESCENT (gstring))) + CHECK_NUMBER (LGSTRING_DESCENT(gstring)); + + for (i = 0; i < LGSTRING_LENGTH (gstring); i++) + { + val = LGSTRING_GLYPH (gstring, i); + CHECK_VECTOR (val); + if (ASIZE (val) < LGSTRING_GLYPH_SIZE) + goto err; + if (NILP (LGLYPH_CHAR (val))) + break; + CHECK_NATNUM (LGLYPH_FROM (val)); + CHECK_NATNUM (LGLYPH_TO (val)); + CHECK_CHARACTER (LGLYPH_CHAR (val)); + if (! NILP (LGLYPH_CODE (val))) + CHECK_NATNUM (LGLYPH_CODE (val)); + if (! NILP (LGLYPH_WIDTH (val))) + CHECK_NATNUM (LGLYPH_WIDTH (val)); + if (! NILP (LGLYPH_ADJUSTMENT (val))) + { + val = LGLYPH_ADJUSTMENT (val); + CHECK_VECTOR (val); + if (ASIZE (val) < 3) + goto err; + for (j = 0; j < 3; j++) + CHECK_NUMBER (AREF (val, j)); + } + } + return i; + err: + error ("Invalid glyph-string format"); + return -1; +} + +static void +check_otf_features (otf_features) + Lisp_Object otf_features; +{ + Lisp_Object val, elt; + + CHECK_CONS (otf_features); + CHECK_SYMBOL (XCAR (otf_features)); + otf_features = XCDR (otf_features); + CHECK_CONS (otf_features); + CHECK_SYMBOL (XCAR (otf_features)); + otf_features = XCDR (otf_features); + for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val)) + { + CHECK_SYMBOL (Fcar (val)); + if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) + error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val))); + } + otf_features = XCDR (otf_features); + for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val)) + { + CHECK_SYMBOL (Fcar (val)); + if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) + error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val))); + } +} + +#ifdef HAVE_LIBOTF +#include <otf.h> + +Lisp_Object otf_list; + +static Lisp_Object +otf_tag_symbol (tag) + OTF_Tag tag; +{ + char name[5]; + + OTF_tag_name (tag, name); + return Fintern (make_unibyte_string (name, 4), Qnil); +} + +static OTF * +otf_open (entity, file) + Lisp_Object entity; + char *file; +{ + Lisp_Object val = Fassoc (entity, otf_list); + OTF *otf; + + if (! NILP (val)) + otf = XSAVE_VALUE (XCDR (val))->pointer; + else + { + otf = file ? OTF_open (file) : NULL; + val = make_save_value (otf, 0); + otf_list = Fcons (Fcons (entity, val), otf_list); + } + return otf; +} + + +/* Return a list describing which scripts/languages FONT supports by + which GSUB/GPOS features of OpenType tables. See the comment of + (sturct font_driver).otf_capability. */ + +Lisp_Object +font_otf_capability (font) + struct font *font; +{ + OTF *otf; + Lisp_Object capability = Fcons (Qnil, Qnil); + int i; + + otf = otf_open (font->entity, font->file_name); + if (! otf) + return Qnil; + for (i = 0; i < 2; i++) + { + OTF_GSUB_GPOS *gsub_gpos; + Lisp_Object script_list = Qnil; + int j; + + if (OTF_get_features (otf, i == 0) < 0) + continue; + gsub_gpos = i == 0 ? otf->gsub : otf->gpos; + for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--) + { + OTF_Script *script = gsub_gpos->ScriptList.Script + j; + Lisp_Object langsys_list = Qnil; + Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag); + int k; + + for (k = script->LangSysCount; k >= 0; k--) + { + OTF_LangSys *langsys; + Lisp_Object feature_list = Qnil; + Lisp_Object langsys_tag; + int l; + + if (k == script->LangSysCount) + { + langsys = &script->DefaultLangSys; + langsys_tag = Qnil; + } + else + { + langsys = script->LangSys + k; + langsys_tag + = otf_tag_symbol (script->LangSysRecord[k].LangSysTag); + } + for (l = langsys->FeatureCount - 1; l >= 0; l--) + { + OTF_Feature *feature + = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l]; + Lisp_Object feature_tag + = otf_tag_symbol (feature->FeatureTag); + + feature_list = Fcons (feature_tag, feature_list); + } + langsys_list = Fcons (Fcons (langsys_tag, feature_list), + langsys_list); + } + script_list = Fcons (Fcons (script_tag, langsys_list), + script_list); + } + + if (i == 0) + XSETCAR (capability, script_list); + else + XSETCDR (capability, script_list); + } + + return capability; +} + +/* Parse OTF features in SPEC and write a proper features spec string + in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is + assured that the sufficient memory has already allocated for + FEATURES. */ + +static void +generate_otf_features (spec, features) + Lisp_Object spec; + char *features; +{ + Lisp_Object val; + char *p, *pend; + int asterisk; + + p = features; + *p = '\0'; + for (asterisk = 0; CONSP (spec); spec = XCDR (spec)) + { + val = XCAR (spec); + CHECK_SYMBOL (val); + if (p > features) + *p++ = ','; + if (SREF (SYMBOL_NAME (val), 0) == '*') + { + asterisk = 1; + *p++ = '*'; + } + else if (! asterisk) + { + val = SYMBOL_NAME (val); + p += sprintf (p, "%s", SDATA (val)); + } + else + { + val = SYMBOL_NAME (val); + p += sprintf (p, "~%s", SDATA (val)); + } + } + if (CONSP (spec)) + error ("OTF spec too long"); +} + + +Lisp_Object +font_otf_DeviceTable (device_table) + OTF_DeviceTable *device_table; +{ + int len = device_table->StartSize - device_table->EndSize + 1; + + return Fcons (make_number (len), + make_unibyte_string (device_table->DeltaValue, len)); +} + +Lisp_Object +font_otf_ValueRecord (value_format, value_record) + int value_format; + OTF_ValueRecord *value_record; +{ + Lisp_Object val = Fmake_vector (make_number (8), Qnil); + + if (value_format & OTF_XPlacement) + ASET (val, 0, value_record->XPlacement); + if (value_format & OTF_YPlacement) + ASET (val, 1, value_record->YPlacement); + if (value_format & OTF_XAdvance) + ASET (val, 2, value_record->XAdvance); + if (value_format & OTF_YAdvance) + ASET (val, 3, value_record->YAdvance); + if (value_format & OTF_XPlaDevice) + ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice)); + if (value_format & OTF_YPlaDevice) + ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice)); + if (value_format & OTF_XAdvDevice) + ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice)); + if (value_format & OTF_YAdvDevice) + ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice)); + return val; +} + +Lisp_Object +font_otf_Anchor (anchor) + OTF_Anchor *anchor; +{ + Lisp_Object val; + + val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil); + ASET (val, 0, make_number (anchor->XCoordinate)); + ASET (val, 1, make_number (anchor->YCoordinate)); + if (anchor->AnchorFormat == 2) + ASET (val, 2, make_number (anchor->f.f1.AnchorPoint)); + else + { + ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable)); + ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable)); + } + return val; +} + +#endif /* HAVE_LIBOTF */ + +/* G-string (glyph string) handler */ + +/* G-string is a vector of the form [HEADER GLYPH ...]. + See the docstring of `font-make-gstring' for more detail. */ + +struct font * +font_prepare_composition (cmp, f) + struct composition *cmp; + FRAME_PTR f; +{ + Lisp_Object gstring + = AREF (XHASH_TABLE (composition_hash_table)->key_and_value, + cmp->hash_index * 2); + + cmp->font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer; + cmp->glyph_len = LGSTRING_LENGTH (gstring); + cmp->pixel_width = LGSTRING_WIDTH (gstring); + cmp->lbearing = LGSTRING_LBEARING (gstring); + cmp->rbearing = LGSTRING_RBEARING (gstring); + cmp->ascent = LGSTRING_ASCENT (gstring); + cmp->descent = LGSTRING_DESCENT (gstring); + cmp->width = cmp->pixel_width / FRAME_COLUMN_WIDTH (f); + if (cmp->width == 0) + cmp->width = 1; + + return cmp->font; +} + + +/* Font sorting */ + +static unsigned font_score P_ ((Lisp_Object, Lisp_Object *)); +static int font_compare P_ ((const void *, const void *)); +static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object)); + +/* We sort fonts by scoring each of them against a specified + font-spec. The score value is 32 bit (`unsigned'), and the smaller + the value is, the closer the font is to the font-spec. + + Each 1-bit of the highest 4 bits of the score is used for atomic + properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY. + + Each 7-bit in the lowest 28 bits are used for numeric properties + WEIGHT, SLANT, WIDTH, and SIZE. */ + +/* How many bits to shift to store the difference value of each font + property in a score. */ +static int sort_shift_bits[FONT_SIZE_INDEX + 1]; + +/* Score font-entity ENTITY against properties of font-spec SPEC_PROP. + The return value indicates how different ENTITY is compared with + SPEC_PROP. */ + +static unsigned +font_score (entity, spec_prop) + Lisp_Object entity, *spec_prop; +{ + unsigned score = 0; + int i; + /* Score four atomic fields. Maximum difference is 1. */ + for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++) + if (! NILP (spec_prop[i]) + && ! EQ (spec_prop[i], AREF (entity, i))) + score |= 1 << sort_shift_bits[i]; + + /* Score four numeric fields. Maximum difference is 127. */ + for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++) + { + Lisp_Object entity_val = AREF (entity, i); + Lisp_Object spec_val = spec_prop[i]; + + /* If weight and slant are unspecified, score normal lower (low wins). */ + if (NILP (spec_val)) + { + if (i == FONT_WEIGHT_INDEX || i == FONT_SLANT_INDEX) + spec_val = prop_name_to_numeric (i, build_string ("normal")); + } + + if (! NILP (spec_val) && ! EQ (spec_val, entity_val)) + { + if (! INTEGERP (entity_val)) + score |= 127 << sort_shift_bits[i]; + else + { + int diff = XINT (entity_val) - XINT (spec_val); + + if (diff < 0) + diff = - diff; + if (i == FONT_SIZE_INDEX) + { + if (XINT (entity_val) > 0 + && diff > FONT_PIXEL_SIZE_QUANTUM) + score |= min (diff, 127) << sort_shift_bits[i]; + } +#ifdef WINDOWSNT + else if (i == FONT_WEIGHT_INDEX) + { + /* Windows uses a much wider range for weight (100-900) + compared with freetype (0-210), so scale down the + difference. A more general way of doing this + would be to look up the values of regular and bold + and/or light and calculate the scale factor from them, + but the lookup would be expensive, and if only Windows + needs it, not worth the effort. */ + score |= min (diff / 4, 127) << sort_shift_bits[i]; + } +#endif + else + score |= min (diff, 127) << sort_shift_bits[i]; + } + } + } + + return score; +} + + +/* The comparison function for qsort. */ + +static int +font_compare (d1, d2) + const void *d1, *d2; +{ + return (*(unsigned *) d1 < *(unsigned *) d2 + ? -1 : *(unsigned *) d1 > *(unsigned *) d2); +} + + +/* The structure for elements being sorted by qsort. */ +struct font_sort_data +{ + unsigned score; + Lisp_Object entity; +}; + + +/* Sort font-entities in vector VEC by closeness to font-spec PREFER. + If PREFER specifies a point-size, calculate the corresponding + pixel-size from QCdpi property of PREFER or from the Y-resolution + of FRAME before sorting. If SPEC is not nil, it is a font-spec to + get the font-entities in VEC. */ + +static Lisp_Object +font_sort_entites (vec, prefer, frame, spec) + Lisp_Object vec, prefer, frame, spec; +{ + Lisp_Object prefer_prop[FONT_SPEC_MAX]; + int len, i; + struct font_sort_data *data; + USE_SAFE_ALLOCA; + + len = ASIZE (vec); + if (len <= 1) + return vec; + + for (i = FONT_FOUNDRY_INDEX; i <= FONT_SIZE_INDEX; i++) + prefer_prop[i] = AREF (prefer, i); + + if (! NILP (spec)) + { + /* As it is assured that all fonts in VEC match with SPEC, we + should ignore properties specified in SPEC. So, set the + corresponding properties in PREFER_PROP to nil. */ + for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++) + if (! NILP (AREF (spec, i))) + prefer_prop[i++] = Qnil; + } + + if (FLOATP (prefer_prop[FONT_SIZE_INDEX])) + prefer_prop[FONT_SIZE_INDEX] + = make_number (font_pixel_size (XFRAME (frame), prefer)); + + /* Scoring and sorting. */ + SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len); + for (i = 0; i < len; i++) + { + data[i].entity = AREF (vec, i); + data[i].score = font_score (data[i].entity, prefer_prop); + } + qsort (data, len, sizeof *data, font_compare); + for (i = 0; i < len; i++) + ASET (vec, i, data[i].entity); + SAFE_FREE (); + + return vec; +} + + +/* API of Font Service Layer. */ + +/* Reflect ORDER (see the variable font_sort_order in xfaces.c) to + sort_shift_bits. Finternal_set_font_selection_order calls this + function with font_sort_order after setting up it. */ + +void +font_update_sort_order (order) + int *order; +{ + int i, shift_bits = 21; + + for (i = 0; i < 4; i++, shift_bits -= 7) + { + int xlfd_idx = order[i]; + + if (xlfd_idx == XLFD_WEIGHT_INDEX) + sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits; + else if (xlfd_idx == XLFD_SLANT_INDEX) + sort_shift_bits[FONT_SLANT_INDEX] = shift_bits; + else if (xlfd_idx == XLFD_SWIDTH_INDEX) + sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits; + else + sort_shift_bits[FONT_SIZE_INDEX] = shift_bits; + } +} + + +/* Return weight property of FONT as symbol. */ + +Lisp_Object +font_symbolic_weight (font) + Lisp_Object font; +{ + Lisp_Object weight = AREF (font, FONT_WEIGHT_INDEX); + + if (INTEGERP (weight)) + weight = prop_numeric_to_name (FONT_WEIGHT_INDEX, XINT (weight)); + return weight; +} + + +/* Return slant property of FONT as symbol. */ + +Lisp_Object +font_symbolic_slant (font) + Lisp_Object font; +{ + Lisp_Object slant = AREF (font, FONT_SLANT_INDEX); + + if (INTEGERP (slant)) + slant = prop_numeric_to_name (FONT_SLANT_INDEX, XINT (slant)); + return slant; +} + + +/* Return width property of FONT as symbol. */ + +Lisp_Object +font_symbolic_width (font) + Lisp_Object font; +{ + Lisp_Object width = AREF (font, FONT_WIDTH_INDEX); + + if (INTEGERP (width)) + width = prop_numeric_to_name (FONT_WIDTH_INDEX, XINT (width)); + return width; +} + + +/* Check if ENTITY matches with the font specification SPEC. */ + +int +font_match_p (spec, entity) + Lisp_Object spec, entity; +{ + int i; + + for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++) + if (! NILP (AREF (spec, i)) + && ! EQ (AREF (spec, i), AREF (entity, i))) + return 0; + if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)) + && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0 + && (XINT (AREF (spec, FONT_SIZE_INDEX)) + != XINT (AREF (entity, FONT_SIZE_INDEX)))) + return 0; + return 1; +} + + +/* Return a lispy font object corresponding to FONT. */ + +Lisp_Object +font_find_object (font) + struct font *font; +{ + Lisp_Object tail, elt; + + for (tail = AREF (font->entity, FONT_OBJLIST_INDEX); CONSP (tail); + tail = XCDR (tail)) + { + elt = XCAR (tail); + if (font == XSAVE_VALUE (elt)->pointer + && XSAVE_VALUE (elt)->integer > 0) + return elt; + } + abort (); + return Qnil; +} + + +/* Font cache + + Each font backend has the callback function get_cache, and it + returns a cons cell of which cdr part can be freely used for + caching fonts. The cons cell may be shared by multiple frames + and/or multiple font drivers. So, we arrange the cdr part as this: + + ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) + + where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES + is a number frames sharing this cache, and FONT-CACHE-DATA is a + cons (FONT-SPEC FONT-ENTITY ...). */ + +static void font_prepare_cache P_ ((FRAME_PTR, struct font_driver *)); +static void font_finish_cache P_ ((FRAME_PTR, struct font_driver *)); +static Lisp_Object font_get_cache P_ ((FRAME_PTR, struct font_driver *)); +static void font_clear_cache P_ ((FRAME_PTR, Lisp_Object, + struct font_driver *)); + +static void +font_prepare_cache (f, driver) + FRAME_PTR f; + struct font_driver *driver; +{ + Lisp_Object cache, val; + + cache = driver->get_cache (f); + val = XCDR (cache); + while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type)) + val = XCDR (val); + if (NILP (val)) + { + val = Fcons (driver->type, Fcons (make_number (1), Qnil)); + XSETCDR (cache, Fcons (val, XCDR (cache))); + } + else + { + val = XCDR (XCAR (val)); + XSETCAR (val, make_number (XINT (XCAR (val)) + 1)); + } +} + +static void +font_finish_cache (f, driver) + FRAME_PTR f; + struct font_driver *driver; +{ + Lisp_Object cache, val, tmp; + + + cache = driver->get_cache (f); + val = XCDR (cache); + while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type)) + cache = val, val = XCDR (val); + xassert (! NILP (val)); + tmp = XCDR (XCAR (val)); + if (XINT (XCAR (tmp)) == 0) + { + font_clear_cache (f, XCAR (val), driver); + XSETCDR (cache, XCDR (val)); + } + else + { + XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1)); + } +} + +static Lisp_Object +font_get_cache (f, driver) + FRAME_PTR f; + struct font_driver *driver; +{ + Lisp_Object val = driver->get_cache (f); + Lisp_Object type = driver->type; + + xassert (CONSP (val)); + for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val)); + xassert (CONSP (val)); + /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */ + val = XCDR (XCAR (val)); + return val; +} + +static void +font_clear_cache (f, cache, driver) + FRAME_PTR f; + Lisp_Object cache; + struct font_driver *driver; +{ + Lisp_Object tail, elt; + + /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */ + for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + if (CONSP (elt) && FONT_SPEC_P (XCAR (elt))) + { + Lisp_Object vec = XCDR (elt); + int i; + + for (i = 0; i < ASIZE (vec); i++) + { + Lisp_Object entity = AREF (vec, i); + + if (EQ (driver->type, AREF (entity, FONT_TYPE_INDEX))) + { + Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX); + + for (; CONSP (objlist); objlist = XCDR (objlist)) + { + Lisp_Object val = XCAR (objlist); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + struct font *font = p->pointer; + + xassert (font && driver == font->driver); + driver->close (f, font); + p->pointer = NULL; + p->integer = 0; + } + if (driver->free_entity) + driver->free_entity (entity); + } + } + } + } + XSETCDR (cache, Qnil); +} + + +static Lisp_Object scratch_font_spec, scratch_font_prefer; + + +/* Return a vector of font-entities matching with SPEC on frame F. */ + +static Lisp_Object +font_list_entities (frame, spec) + Lisp_Object frame, spec; +{ + FRAME_PTR f = XFRAME (frame); + struct font_driver_list *driver_list = f->font_driver_list; + Lisp_Object ftype, family, size, alternate_familes; + Lisp_Object *vec = alloca (sizeof (Lisp_Object) * num_font_drivers); + int i; + + if (! vec) + return null_vector; + + family = AREF (spec, FONT_FAMILY_INDEX); + if (NILP (family)) + alternate_familes = Qnil; + else + { + if (NILP (font_family_alist) + && !NILP (Vface_alternative_font_family_alist)) + build_font_family_alist (); + alternate_familes = assq_no_quit (family, font_family_alist); + if (! NILP (alternate_familes)) + alternate_familes = XCDR (alternate_familes); + } + size = AREF (spec, FONT_SIZE_INDEX); + if (FLOATP (size)) + ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec))); + + xassert (ASIZE (spec) == FONT_SPEC_MAX); + ftype = AREF (spec, FONT_TYPE_INDEX); + + for (i = 0; driver_list; driver_list = driver_list->next) + if (driver_list->on + && (NILP (ftype) || EQ (driver_list->driver->type, ftype))) + { + Lisp_Object cache = font_get_cache (f, driver_list->driver); + Lisp_Object tail = alternate_familes; + + ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type); + ASET (spec, FONT_FAMILY_INDEX, family); + + while (1) + { + Lisp_Object val = assoc_no_quit (spec, XCDR (cache)); + + if (CONSP (val)) + val = XCDR (val); + else + { + val = driver_list->driver->list (frame, spec); + if (VECTORP (val)) + XSETCDR (cache, Fcons (Fcons (Fcopy_sequence (spec), val), + XCDR (cache))); + } + if (VECTORP (val) && ASIZE (val) > 0) + { + vec[i++] = val; + break; + } + if (NILP (tail)) + break; + ASET (spec, FONT_FAMILY_INDEX, XCAR (tail)); + tail = XCDR (tail); + } + } + ASET (spec, FONT_TYPE_INDEX, ftype); + ASET (spec, FONT_FAMILY_INDEX, family); + ASET (spec, FONT_SIZE_INDEX, size); + return (i > 0 ? Fvconcat (i, vec) : null_vector); +} + + +/* Return a font entity matching with SPEC on FRAME. */ + +static Lisp_Object +font_matching_entity (frame, spec) + Lisp_Object frame, spec; +{ + FRAME_PTR f = XFRAME (frame); + struct font_driver_list *driver_list = f->font_driver_list; + Lisp_Object ftype, size, entity; + + ftype = AREF (spec, FONT_TYPE_INDEX); + size = AREF (spec, FONT_SIZE_INDEX); + if (FLOATP (size)) + ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec))); + entity = Qnil; + for (; driver_list; driver_list = driver_list->next) + if (driver_list->on + && (NILP (ftype) || EQ (driver_list->driver->type, ftype))) + { + Lisp_Object cache = font_get_cache (f, driver_list->driver); + Lisp_Object key; + + ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type); + key = Fcons (spec, Qnil); + entity = assoc_no_quit (key, XCDR (cache)); + if (CONSP (entity)) + entity = XCDR (entity); + else + { + entity = driver_list->driver->match (frame, spec); + if (! NILP (entity)) + { + XSETCAR (key, Fcopy_sequence (spec)); + XSETCDR (cache, Fcons (Fcons (key, entity), XCDR (cache))); + } + } + if (! NILP (entity)) + break; + } + ASET (spec, FONT_TYPE_INDEX, ftype); + ASET (spec, FONT_SIZE_INDEX, size); + return entity; +} + +static int num_fonts; + + +/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the + opened font object. */ + +static Lisp_Object +font_open_entity (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + struct font_driver_list *driver_list; + Lisp_Object objlist, size, val; + struct font *font; + + size = AREF (entity, FONT_SIZE_INDEX); + xassert (NATNUMP (size)); + if (XINT (size) != 0) + pixel_size = XINT (size); + + for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist); + objlist = XCDR (objlist)) + { + font = XSAVE_VALUE (XCAR (objlist))->pointer; + if (font->pixel_size == pixel_size) + { + XSAVE_VALUE (XCAR (objlist))->integer++; + return XCAR (objlist); + } + } + + xassert (FONT_ENTITY_P (entity)); + val = AREF (entity, FONT_TYPE_INDEX); + for (driver_list = f->font_driver_list; + driver_list && ! EQ (driver_list->driver->type, val); + driver_list = driver_list->next); + if (! driver_list) + return Qnil; + + font = driver_list->driver->open (f, entity, pixel_size); + if (! font) + return Qnil; + font->scalable = XINT (size) == 0; + + val = make_save_value (font, 1); + ASET (entity, FONT_OBJLIST_INDEX, + Fcons (val, AREF (entity, FONT_OBJLIST_INDEX))); + num_fonts++; + return val; +} + + +/* Close FONT_OBJECT that is opened on frame F. */ + +void +font_close_object (f, font_object) + FRAME_PTR f; + Lisp_Object font_object; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + Lisp_Object objlist; + Lisp_Object tail, prev = Qnil; + + XSAVE_VALUE (font_object)->integer--; + xassert (XSAVE_VALUE (font_object)->integer >= 0); + if (XSAVE_VALUE (font_object)->integer > 0) + return; + + objlist = AREF (font->entity, FONT_OBJLIST_INDEX); + for (prev = Qnil, tail = objlist; CONSP (tail); + prev = tail, tail = XCDR (tail)) + if (EQ (font_object, XCAR (tail))) + { + if (font->driver->close) + font->driver->close (f, font); + XSAVE_VALUE (font_object)->pointer = NULL; + if (NILP (prev)) + ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist)); + else + XSETCDR (prev, XCDR (objlist)); + return; + } + abort (); +} + + +/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if + FONT is a font-entity and it must be opened to check. */ + +int +font_has_char (f, font, c) + FRAME_PTR f; + Lisp_Object font; + int c; +{ + struct font *fontp; + + if (FONT_ENTITY_P (font)) + { + Lisp_Object type = AREF (font, FONT_TYPE_INDEX); + struct font_driver_list *driver_list; + + for (driver_list = f->font_driver_list; + driver_list && ! EQ (driver_list->driver->type, type); + driver_list = driver_list->next); + if (! driver_list) + return 0; + if (! driver_list->driver->has_char) + return -1; + return driver_list->driver->has_char (font, c); + } + + xassert (FONT_OBJECT_P (font)); + fontp = XSAVE_VALUE (font)->pointer; + + if (fontp->driver->has_char) + { + int result = fontp->driver->has_char (fontp->entity, c); + + if (result >= 0) + return result; + } + return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE); +} + + +/* Return the glyph ID of FONT_OBJECT for character C. */ + +unsigned +font_encode_char (font_object, c) + Lisp_Object font_object; + int c; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + + return font->driver->encode_char (font, c); +} + + +/* Return the name of FONT_OBJECT. */ + +Lisp_Object +font_get_name (font_object) + Lisp_Object font_object; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + char *name = (font->font.full_name ? font->font.full_name + : font->font.name ? font->font.name + : NULL); + + return (name ? make_unibyte_string (name, strlen (name)) : null_string); +} + + +/* Return the specification of FONT_OBJECT. */ + +Lisp_Object +font_get_spec (font_object) + Lisp_Object font_object; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + Lisp_Object spec = Ffont_spec (0, NULL); + int i; + + for (i = 0; i < FONT_SIZE_INDEX; i++) + ASET (spec, i, AREF (font->entity, i)); + ASET (spec, FONT_SIZE_INDEX, make_number (font->pixel_size)); + return spec; +} + + +/* Return the frame on which FONT exists. FONT is a font object or a + font entity. */ + +Lisp_Object +font_get_frame (font) + Lisp_Object font; +{ + if (FONT_OBJECT_P (font)) + font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity; + xassert (FONT_ENTITY_P (font)); + return AREF (font, FONT_FRAME_INDEX); +} + + +/* Find a font entity best matching with LFACE. If SPEC is non-nil, + the font must exactly match with it. C, if not negative, is a + character that the entity must support. */ + +Lisp_Object +font_find_for_lface (f, lface, spec, c) + FRAME_PTR f; + Lisp_Object *lface; + Lisp_Object spec; + int c; +{ + Lisp_Object frame, entities; + int i; + + XSETFRAME (frame, f); + + if (NILP (spec)) + { + if (c >= 0x100) + return Qnil; + for (i = 0; i < FONT_SPEC_MAX; i++) + ASET (scratch_font_spec, i, Qnil); + ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1); + + if (! NILP (lface[LFACE_FAMILY_INDEX])) + font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil, + scratch_font_spec); + entities = font_list_entities (frame, scratch_font_spec); + while (ASIZE (entities) == 0) + { + /* Try without FOUNDRY or FAMILY. */ + if (! NILP (AREF (scratch_font_spec, FONT_FOUNDRY_INDEX))) + { + ASET (scratch_font_spec, FONT_FOUNDRY_INDEX, Qnil); + entities = font_list_entities (frame, scratch_font_spec); + } + else if (! NILP (AREF (scratch_font_spec, FONT_FAMILY_INDEX))) + { + ASET (scratch_font_spec, FONT_FAMILY_INDEX, Qnil); + entities = font_list_entities (frame, scratch_font_spec); + } + else + break; + } + } + else + { + Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX); + + if (NILP (registry)) + registry = Qiso8859_1; + + if (c >= 0) + { + struct charset *repertory; + + if (font_registry_charsets (registry, NULL, &repertory) < 0) + return Qnil; + if (repertory) + { + if (ENCODE_CHAR (repertory, c) + == CHARSET_INVALID_CODE (repertory)) + return Qnil; + /* Any font of this registry support C. So, let's + suppress the further checking. */ + c = -1; + } + else if (c > MAX_UNICODE_CHAR) + return Qnil; + } + for (i = 0; i < FONT_SPEC_MAX; i++) + ASET (scratch_font_spec, i, AREF (spec, i)); + ASET (scratch_font_spec, FONT_REGISTRY_INDEX, registry); + entities = font_list_entities (frame, scratch_font_spec); + } + + if (ASIZE (entities) == 0) + return Qnil; + if (ASIZE (entities) > 1) + { + /* Sort fonts by properties specified in LFACE. */ + Lisp_Object prefer = scratch_font_prefer; + double pt; + + if (! NILP (lface[LFACE_FAMILY_INDEX])) + font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil, prefer); + ASET (prefer, FONT_WEIGHT_INDEX, + font_prop_validate_style (QCweight, lface[LFACE_WEIGHT_INDEX])); + ASET (prefer, FONT_SLANT_INDEX, + font_prop_validate_style (QCslant, lface[LFACE_SLANT_INDEX])); + ASET (prefer, FONT_WIDTH_INDEX, + font_prop_validate_style (QCwidth, lface[LFACE_SWIDTH_INDEX])); + pt = XINT (lface[LFACE_HEIGHT_INDEX]); + ASET (prefer, FONT_SIZE_INDEX, make_float (pt / 10)); + + font_sort_entites (entities, prefer, frame, spec); + } + + if (c < 0) + return AREF (entities, 0); + for (i = 0; i < ASIZE (entities); i++) + { + int result = font_has_char (f, AREF (entities, i), c); + Lisp_Object font_object; + + if (result > 0) + return AREF (entities, i); + if (result <= 0) + continue; + font_object = font_open_for_lface (f, AREF (entities, i), lface, spec); + if (NILP (font_object)) + continue; + result = font_has_char (f, font_object, c); + font_close_object (f, font_object); + if (result > 0) + return AREF (entities, i); + } + return Qnil; +} + + +Lisp_Object +font_open_for_lface (f, entity, lface, spec) + FRAME_PTR f; + Lisp_Object entity; + Lisp_Object *lface; + Lisp_Object spec; +{ + int size; + + if (FONT_SPEC_P (spec) && INTEGERP (AREF (spec, FONT_SIZE_INDEX))) + size = XINT (AREF (spec, FONT_SIZE_INDEX)); + else + { + double pt = XINT (lface[LFACE_HEIGHT_INDEX]); + + pt /= 10; + size = POINT_TO_PIXEL (pt, f->resy); + } + return font_open_entity (f, entity, size); +} + + +/* Load a font best matching with FACE's font-related properties into + FACE on frame F. If no proper font is found, record that FACE has + no font. */ + +void +font_load_for_face (f, face) + FRAME_PTR f; + struct face *face; +{ + Lisp_Object font_object = face->lface[LFACE_FONT_INDEX]; + + if (NILP (font_object)) + { + Lisp_Object entity = font_find_for_lface (f, face->lface, Qnil, -1); + + if (! NILP (entity)) + font_object = font_open_for_lface (f, entity, face->lface, Qnil); + } + + if (! NILP (font_object)) + { + struct font *font = XSAVE_VALUE (font_object)->pointer; + + face->font = font->font.font; + face->font_info = (struct font_info *) font; + face->font_info_id = 0; + face->font_name = font->font.full_name; + } + else + { + face->font = NULL; + face->font_info = NULL; + face->font_info_id = -1; + face->font_name = NULL; + add_to_log ("Unable to load font for a face%s", null_string, Qnil); + } +} + + +/* Make FACE on frame F ready to use the font opened for FACE. */ + +void +font_prepare_for_face (f, face) + FRAME_PTR f; + struct face *face; +{ + struct font *font = (struct font *) face->font_info; + + if (font->driver->prepare_face) + font->driver->prepare_face (f, face); +} + + +/* Make FACE on frame F stop using the font opened for FACE. */ + +void +font_done_for_face (f, face) + FRAME_PTR f; + struct face *face; +{ + struct font *font = (struct font *) face->font_info; + + if (font->driver->done_face) + font->driver->done_face (f, face); + face->extra = NULL; +} + + +/* Open a font best matching with NAME on frame F. If no proper font + is found, return Qnil. */ + +Lisp_Object +font_open_by_name (f, name) + FRAME_PTR f; + char *name; +{ + Lisp_Object args[2]; + Lisp_Object spec, prefer, size, entity, entity_list; + Lisp_Object frame; + int i; + int pixel_size; + + XSETFRAME (frame, f); + + args[0] = QCname; + args[1] = make_unibyte_string (name, strlen (name)); + spec = Ffont_spec (2, args); + prefer = scratch_font_prefer; + for (i = FONT_WEIGHT_INDEX; i < FONT_SIZE_INDEX; i++) + if (NILP (AREF (spec, i))) + ASET (prefer, i, make_number (100)); + size = AREF (spec, FONT_SIZE_INDEX); + if (NILP (size)) + pixel_size = 0; + else if (INTEGERP (size)) + pixel_size = XINT (size); + else /* FLOATP (size) */ + { + double pt = XFLOAT_DATA (size); + + pixel_size = POINT_TO_PIXEL (pt, f->resy); + size = make_number (pixel_size); + ASET (spec, FONT_SIZE_INDEX, size); + } + if (pixel_size == 0) + { + pixel_size = POINT_TO_PIXEL (12.0, f->resy); + size = make_number (pixel_size); + } + ASET (prefer, FONT_SIZE_INDEX, size); + if (NILP (AREF (spec, FONT_REGISTRY_INDEX))) + ASET (spec, FONT_REGISTRY_INDEX, Qiso8859_1); + + entity_list = Flist_fonts (spec, frame, make_number (1), prefer); + if (NILP (entity_list)) + entity = font_matching_entity (frame, spec); + else + entity = XCAR (entity_list); + return (NILP (entity) + ? Qnil + : font_open_entity (f, entity, pixel_size)); +} + + +/* Register font-driver DRIVER. This function is used in two ways. + + The first is with frame F non-NULL. In this case, make DRIVER + available (but not yet activated) on F. All frame creaters + (e.g. Fx_create_frame) must call this function at least once with + an available font-driver. + + The second is with frame F NULL. In this case, DRIVER is globally + registered in the variable `font_driver_list'. All font-driver + implementations must call this function in its syms_of_XXXX + (e.g. syms_of_xfont). */ + +void +register_font_driver (driver, f) + struct font_driver *driver; + FRAME_PTR f; +{ + struct font_driver_list *root = f ? f->font_driver_list : font_driver_list; + struct font_driver_list *prev, *list; + + if (f && ! driver->draw) + error ("Unsable font driver for a frame: %s", + SDATA (SYMBOL_NAME (driver->type))); + + for (prev = NULL, list = root; list; prev = list, list = list->next) + if (EQ (list->driver->type, driver->type)) + error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type))); + + list = malloc (sizeof (struct font_driver_list)); + list->on = 0; + list->driver = driver; + list->next = NULL; + if (prev) + prev->next = list; + else if (f) + f->font_driver_list = list; + else + font_driver_list = list; + num_font_drivers++; +} + + +/* Free font-driver list on frame F. It doesn't free font-drivers + themselves. */ + +void +free_font_driver_list (f) + FRAME_PTR f; +{ + while (f->font_driver_list) + { + struct font_driver_list *next = f->font_driver_list->next; + + free (f->font_driver_list); + f->font_driver_list = next; + } +} + + +/* Make the frame F use font backends listed in NEW_DRIVERS (list of + symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all + available font drivers. If NEW_DRIVERS is nil, finalize all drivers. + + A caller must free all realized faces if any in advance. The + return value is a list of font backends actually made used on + F. */ + +Lisp_Object +font_update_drivers (f, new_drivers) + FRAME_PTR f; + Lisp_Object new_drivers; +{ + Lisp_Object active_drivers = Qnil; + struct font_driver_list *list; + + for (list = f->font_driver_list; list; list = list->next) + if (list->on) + { + if (! EQ (new_drivers, Qt) + && NILP (Fmemq (list->driver->type, new_drivers))) + { + if (list->driver->end_for_frame) + list->driver->end_for_frame (f); + font_finish_cache (f, list->driver); + list->on = 0; + } + } + else + { + if (EQ (new_drivers, Qt) + || ! NILP (Fmemq (list->driver->type, new_drivers))) + { + if (! list->driver->start_for_frame + || list->driver->start_for_frame (f) == 0) + { + font_prepare_cache (f, list->driver); + list->on = 1; + active_drivers = nconc2 (active_drivers, + Fcons (list->driver->type, Qnil)); + } + } + } + + return active_drivers; +} + +int +font_put_frame_data (f, driver, data) + FRAME_PTR f; + struct font_driver *driver; + void *data; +{ + struct font_data_list *list, *prev; + + for (prev = NULL, list = f->font_data_list; list; + prev = list, list = list->next) + if (list->driver == driver) + break; + if (! data) + { + if (list) + { + if (prev) + prev->next = list->next; + else + f->font_data_list = list->next; + free (list); + } + return 0; + } + + if (! list) + { + list = malloc (sizeof (struct font_data_list)); + if (! list) + return -1; + list->driver = driver; + list->next = f->font_data_list; + f->font_data_list = list; + } + list->data = data; + return 0; +} + + +void * +font_get_frame_data (f, driver) + FRAME_PTR f; + struct font_driver *driver; +{ + struct font_data_list *list; + + for (list = f->font_data_list; list; list = list->next) + if (list->driver == driver) + break; + if (! list) + return NULL; + return list->data; +} + + +/* Return the font used to draw character C by FACE at buffer position + POS in window W. If STRING is non-nil, it is a string containing C + at index POS. If C is negative, get C from the current buffer or + STRING. */ + +Lisp_Object +font_at (c, pos, face, w, string) + int c; + EMACS_INT pos; + struct face *face; + struct window *w; + Lisp_Object string; +{ + FRAME_PTR f; + int multibyte; + + if (c < 0) + { + if (NILP (string)) + { + multibyte = ! NILP (current_buffer->enable_multibyte_characters); + if (multibyte) + { + EMACS_INT pos_byte = CHAR_TO_BYTE (pos); + + c = FETCH_CHAR (pos_byte); + } + else + c = FETCH_BYTE (pos); + } + else + { + unsigned char *str; + + multibyte = STRING_MULTIBYTE (string); + if (multibyte) + { + EMACS_INT pos_byte = string_char_to_byte (string, pos); + + str = SDATA (string) + pos_byte; + c = STRING_CHAR (str, 0); + } + else + c = SDATA (string)[pos]; + } + } + + f = XFRAME (w->frame); + if (! FRAME_WINDOW_P (f)) + return Qnil; + if (! face) + { + int face_id; + int endptr; + + if (STRINGP (string)) + face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr, + DEFAULT_FACE_ID, 0); + else + face_id = face_at_buffer_position (w, pos, -1, -1, &endptr, + pos + 100, 0); + face = FACE_FROM_ID (f, face_id); + } + if (multibyte) + { + int face_id = FACE_FOR_CHAR (f, face, c, pos, string); + face = FACE_FROM_ID (f, face_id); + } + if (! face->font_info) + return Qnil; + return font_find_object ((struct font *) face->font_info); +} + + +/* Lisp API */ + +DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0, + doc: /* Return t if OBJECT is a font-spec or font-entity. +Return nil otherwise. */) + (object) + Lisp_Object object; +{ + return (FONTP (object) ? Qt : Qnil); +} + +DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0, + doc: /* Return a newly created font-spec with arguments as properties. + +ARGS must come in pairs KEY VALUE of font properties. KEY must be a +valid font property name listed below: + +`:family', `:weight', `:slant', `:width' + +They are the same as face attributes of the same name. See +`set-face-attribute. + +`:foundry' + +VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''. + +`:adstyle' + +VALUE must be a string or a symbol specifying the additional +typographic style information of a font, e.g. ``sans''. Usually null. + +`:registry' + +VALUE must be a string or a symbol specifying the charset registry and +encoding of a font, e.g. ``iso8859-1''. + +`:size' + +VALUE must be a non-negative integer or a floating point number +specifying the font size. It specifies the font size in 1/10 pixels +(if VALUE is an integer), or in points (if VALUE is a float). +usage: (font-spec ARGS ...) */) + (nargs, args) + int nargs; + Lisp_Object *args; +{ + Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil); + int i; + + for (i = 0; i < nargs; i += 2) + { + enum font_property_index prop; + Lisp_Object key = args[i], val = args[i + 1]; + + prop = get_font_prop_index (key, 0); + if (prop < FONT_EXTRA_INDEX) + ASET (spec, prop, val); + else + { + if (EQ (key, QCname)) + { + CHECK_STRING (val); + font_parse_name ((char *) SDATA (val), spec); + } + font_put_extra (spec, key, val); + } + } + CHECK_VALIDATE_FONT_SPEC (spec); + return spec; +} + + +DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0, + doc: /* Return the value of FONT's property KEY. +FONT is a font-spec, a font-entity, or a font-object. */) + (font, key) + Lisp_Object font, key; +{ + enum font_property_index idx; + + if (FONT_OBJECT_P (font)) + { + struct font *fontp = XSAVE_VALUE (font)->pointer; + + if (EQ (key, QCotf)) + { + if (fontp->driver->otf_capability) + return fontp->driver->otf_capability (fontp); + else + return Qnil; + } + font = fontp->entity; + } + else + CHECK_FONT (font); + idx = get_font_prop_index (key, 0); + if (idx < FONT_EXTRA_INDEX) + return AREF (font, idx); + if (FONT_ENTITY_P (font)) + return Qnil; + return Fcdr (Fassoc (key, AREF (font, FONT_EXTRA_INDEX))); +} + + +DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0, + doc: /* Set one property of FONT-SPEC: give property KEY value VALUE. */) + (font_spec, prop, val) + Lisp_Object font_spec, prop, val; +{ + enum font_property_index idx; + Lisp_Object extra, slot; + + CHECK_FONT_SPEC (font_spec); + idx = get_font_prop_index (prop, 0); + if (idx < FONT_EXTRA_INDEX) + return ASET (font_spec, idx, val); + extra = AREF (font_spec, FONT_EXTRA_INDEX); + slot = Fassoc (extra, prop); + if (NILP (slot)) + extra = Fcons (Fcons (prop, val), extra); + else + Fsetcdr (slot, val); + return val; +} + +DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0, + doc: /* List available fonts matching FONT-SPEC on the current frame. +Optional 2nd argument FRAME specifies the target frame. +Optional 3rd argument NUM, if non-nil, limits the number of returned fonts. +Optional 4th argument PREFER, if non-nil, is a font-spec to +control the order of the returned list. Fonts are sorted by +how they are close to PREFER. */) + (font_spec, frame, num, prefer) + Lisp_Object font_spec, frame, num, prefer; +{ + Lisp_Object vec, list, tail; + int n = 0, i, len; + + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + CHECK_VALIDATE_FONT_SPEC (font_spec); + if (! NILP (num)) + { + CHECK_NUMBER (num); + n = XINT (num); + if (n <= 0) + return Qnil; + } + if (! NILP (prefer)) + CHECK_FONT (prefer); + + vec = font_list_entities (frame, font_spec); + len = ASIZE (vec); + if (len == 0) + return Qnil; + if (len == 1) + return Fcons (AREF (vec, 0), Qnil); + + if (! NILP (prefer)) + vec = font_sort_entites (vec, prefer, frame, font_spec); + + list = tail = Fcons (AREF (vec, 0), Qnil); + if (n == 0 || n > len) + n = len; + for (i = 1; i < n; i++) + { + Lisp_Object val = Fcons (AREF (vec, i), Qnil); + + XSETCDR (tail, val); + tail = val; + } + return list; +} + +DEFUN ("list-families", Flist_families, Slist_families, 0, 1, 0, + doc: /* List available font families on the current frame. +Optional 2nd argument FRAME specifies the target frame. */) + (frame) + Lisp_Object frame; +{ + FRAME_PTR f; + struct font_driver_list *driver_list; + Lisp_Object list; + + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + f = XFRAME (frame); + list = Qnil; + for (driver_list = f->font_driver_list; driver_list; + driver_list = driver_list->next) + if (driver_list->driver->list_family) + { + Lisp_Object val = driver_list->driver->list_family (frame); + + if (NILP (list)) + list = val; + else + { + Lisp_Object tail = list; + + for (; CONSP (val); val = XCDR (val)) + if (NILP (Fmemq (XCAR (val), tail))) + list = Fcons (XCAR (val), list); + } + } + return list; +} + +DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0, + doc: /* Return a font-entity matching with FONT-SPEC on the current frame. +Optional 2nd argument FRAME, if non-nil, specifies the target frame. */) + (font_spec, frame) + Lisp_Object font_spec, frame; +{ + Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil); + + if (CONSP (val)) + val = XCAR (val); + return val; +} + +DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0, + doc: /* Return XLFD name of FONT. +FONT is a font-spec, font-entity, or font-object. +If the name is too long for XLFD (maximum 255 chars), return nil. */) + (font) + Lisp_Object font; +{ + char name[256]; + int pixel_size = 0; + + if (FONT_SPEC_P (font)) + CHECK_VALIDATE_FONT_SPEC (font); + else if (FONT_ENTITY_P (font)) + CHECK_FONT (font); + else + { + struct font *fontp; + + CHECK_FONT_GET_OBJECT (font, fontp); + font = fontp->entity; + pixel_size = fontp->pixel_size; + } + + if (font_unparse_xlfd (font, pixel_size, name, 256) < 0) + return Qnil; + return build_string (name); +} + +DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0, + doc: /* Clear font cache. */) + () +{ + Lisp_Object list, frame; + + FOR_EACH_FRAME (list, frame) + { + FRAME_PTR f = XFRAME (frame); + struct font_driver_list *driver_list = f->font_driver_list; + + for (; driver_list; driver_list = driver_list->next) + if (driver_list->on) + { + Lisp_Object cache = driver_list->driver->get_cache (f); + Lisp_Object val; + + val = XCDR (cache); + while (! EQ (XCAR (val), driver_list->driver->type)) + val = XCDR (val); + val = XCDR (XCAR (val)); + if (XINT (XCAR (val)) == 0) + { + font_clear_cache (f, XCAR (val), driver_list->driver); + XSETCDR (cache, XCDR (val)); + } + } + } + + return Qnil; +} + +DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table, + Sinternal_set_font_style_table, 2, 2, 0, + doc: /* Set font style table for PROP to TABLE. +PROP must be `:weight', `:slant', or `:width'. +TABLE must be an alist of symbols vs the corresponding numeric values +sorted by numeric values. */) + (prop, table) + Lisp_Object prop, table; +{ + int table_index; + int numeric; + Lisp_Object tail, val; + + CHECK_SYMBOL (prop); + table_index = (EQ (prop, QCweight) ? 0 + : EQ (prop, QCslant) ? 1 + : EQ (prop, QCwidth) ? 2 + : 3); + if (table_index >= ASIZE (font_style_table)) + error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop))); + table = Fcopy_sequence (table); + numeric = -1; + for (tail = table; ! NILP (tail); tail = Fcdr (tail)) + { + prop = Fcar (Fcar (tail)); + val = Fcdr (Fcar (tail)); + CHECK_SYMBOL (prop); + CHECK_NATNUM (val); + if (numeric > XINT (val)) + error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop))); + numeric = XINT (val); + XSETCAR (tail, Fcons (prop, val)); + } + ASET (font_style_table, table_index, table); + return Qnil; +} + +/* The following three functions are still expremental. */ + +DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0, + doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs. +FONT-OBJECT may be nil if it is not yet known. + +G-string is sequence of glyphs of a specific font, +and is a vector of this form: + [ HEADER GLYPH ... ] +HEADER is a vector of this form: + [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT] +where + FONT-OBJECT is a font-object for all glyphs in the g-string, + WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string. +GLYPH is a vector of this form: + [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT + [ [X-OFF Y-OFF WADJUST] | nil] ] +where + FROM-IDX and TO-IDX are used internally and should not be touched. + C is the character of the glyph. + CODE is the glyph-code of C in FONT-OBJECT. + WIDTH thry DESCENT are the metrics (in pixels) of the glyph. + X-OFF and Y-OFF are offests to the base position for the glyph. + WADJUST is the adjustment to the normal width of the glyph. */) + (font_object, num) + Lisp_Object font_object, num; +{ + Lisp_Object gstring, g; + int len; + int i; + + if (! NILP (font_object)) + CHECK_FONT_OBJECT (font_object); + CHECK_NATNUM (num); + + len = XINT (num) + 1; + gstring = Fmake_vector (make_number (len), Qnil); + g = Fmake_vector (make_number (6), Qnil); + ASET (g, 0, font_object); + ASET (gstring, 0, g); + for (i = 1; i < len; i++) + ASET (gstring, i, Fmake_vector (make_number (10), Qnil)); + return gstring; +} + +DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0, + doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT. +START and END specifies the region to extract characters. +If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from +where to extract characters. +FONT-OBJECT may be nil if GSTRING already already contains one. */) + (gstring, font_object, start, end, object) + Lisp_Object gstring, font_object, start, end, object; +{ + int len, i, c; + unsigned code; + struct font *font; + + CHECK_VECTOR (gstring); + if (NILP (font_object)) + font_object = LGSTRING_FONT (gstring); + CHECK_FONT_GET_OBJECT (font_object, font); + + if (STRINGP (object)) + { + const unsigned char *p; + + CHECK_NATNUM (start); + CHECK_NATNUM (end); + if (XINT (start) > XINT (end) + || XINT (end) > ASIZE (object) + || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring)) + args_out_of_range_3 (object, start, end); + + len = XINT (end) - XINT (start); + p = SDATA (object) + string_char_to_byte (object, XINT (start)); + for (i = 0; i < len; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring, i); + + c = STRING_CHAR_ADVANCE (p); + code = font->driver->encode_char (font, c); + if (code > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE) + break; + LGLYPH_SET_FROM (g, i); + LGLYPH_SET_TO (g, i); + LGLYPH_SET_CHAR (g, c); + LGLYPH_SET_CODE (g, code); + } + } + else + { + int pos, pos_byte; + + if (! NILP (object)) + Fset_buffer (object); + validate_region (&start, &end); + if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring)) + args_out_of_range (start, end); + len = XINT (end) - XINT (start); + pos = XINT (start); + pos_byte = CHAR_TO_BYTE (pos); + for (i = 0; i < len; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring, i); + + FETCH_CHAR_ADVANCE (c, pos, pos_byte); + code = font->driver->encode_char (font, c); + if (code > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE) + break; + LGLYPH_SET_FROM (g, i); + LGLYPH_SET_TO (g, i); + LGLYPH_SET_CHAR (g, c); + LGLYPH_SET_CODE (g, code); + } + } + for (; i < LGSTRING_LENGTH (gstring); i++) + LGSTRING_SET_GLYPH (gstring, i, Qnil); + return Qnil; +} + +DEFUN ("font-shape-text", Ffont_shape_text, Sfont_shape_text, 3, 4, 0, + doc: /* Shape text between FROM and TO by FONT-OBJECT. +If optional 4th argument STRING is non-nil, it is a string to shape, +and FROM and TO are indices to the string. +The value is the end position of the text that can be shaped by +FONT-OBJECT. */) + (from, to, font_object, string) + Lisp_Object from, to, font_object, string; +{ + struct font *font; + struct font_metrics metrics; + EMACS_INT start, end; + Lisp_Object gstring, n; + int len, i, j; + + if (NILP (string)) + { + validate_region (&from, &to); + start = XFASTINT (from); + end = XFASTINT (to); + modify_region (current_buffer, start, end, 0); + } + else + { + CHECK_STRING (string); + start = XINT (from); + end = XINT (to); + if (start < 0 || start > end || end > SCHARS (string)) + args_out_of_range_3 (string, from, to); + } + + CHECK_FONT_GET_OBJECT (font_object, font); + if (! font->driver->shape) + return from; + + len = end - start; + gstring = Ffont_make_gstring (font_object, make_number (len)); + Ffont_fill_gstring (gstring, font_object, from, to, string); + + /* Try at most three times with larger gstring each time. */ + for (i = 0; i < 3; i++) + { + Lisp_Object args[2]; + + n = font->driver->shape (gstring); + if (INTEGERP (n)) + break; + args[0] = gstring; + args[1] = Fmake_vector (make_number (len), Qnil); + gstring = Fvconcat (2, args); + } + if (! INTEGERP (n) || XINT (n) == 0) + return Qnil; + len = XINT (n); + + for (i = 0; i < len;) + { + Lisp_Object gstr; + Lisp_Object g = LGSTRING_GLYPH (gstring, i); + EMACS_INT this_from = LGLYPH_FROM (g); + EMACS_INT this_to = LGLYPH_TO (g) + 1; + int j, k; + int need_composition = 0; + + metrics.lbearing = LGLYPH_LBEARING (g); + metrics.rbearing = LGLYPH_RBEARING (g); + metrics.ascent = LGLYPH_ASCENT (g); + metrics.descent = LGLYPH_DESCENT (g); + if (NILP (LGLYPH_ADJUSTMENT (g))) + { + metrics.width = LGLYPH_WIDTH (g); + if (XINT (LGLYPH_CHAR (g)) == 0 || metrics.width == 0) + need_composition = 1; + } + else + { + metrics.width = LGLYPH_WADJUST (g); + metrics.lbearing += LGLYPH_XOFF (g); + metrics.rbearing += LGLYPH_XOFF (g); + metrics.ascent -= LGLYPH_YOFF (g); + metrics.descent += LGLYPH_YOFF (g); + need_composition = 1; + } + for (j = i + 1; j < len; j++) + { + int x; + + g = LGSTRING_GLYPH (gstring, j); + if (this_from != LGLYPH_FROM (g)) + break; + need_composition = 1; + x = metrics.width + LGLYPH_LBEARING (g) + LGLYPH_XOFF (g); + if (metrics.lbearing > x) + metrics.lbearing = x; + x = metrics.width + LGLYPH_RBEARING (g) + LGLYPH_XOFF (g); + if (metrics.rbearing < x) + metrics.rbearing = x; + x = LGLYPH_ASCENT (g) - LGLYPH_YOFF (g); + if (metrics.ascent < x) + metrics.ascent = x; + x = LGLYPH_DESCENT (g) - LGLYPH_YOFF (g); + if (metrics.descent < x) + metrics.descent = x; + if (NILP (LGLYPH_ADJUSTMENT (g))) + metrics.width += LGLYPH_WIDTH (g); + else + metrics.width += LGLYPH_WADJUST (g); + } + + if (need_composition) + { + gstr = Ffont_make_gstring (font_object, make_number (j - i)); + LGSTRING_SET_WIDTH (gstr, metrics.width); + LGSTRING_SET_LBEARING (gstr, metrics.lbearing); + LGSTRING_SET_RBEARING (gstr, metrics.rbearing); + LGSTRING_SET_ASCENT (gstr, metrics.ascent); + LGSTRING_SET_DESCENT (gstr, metrics.descent); + for (k = i; i < j; i++) + LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i)); + from = make_number (start + this_from); + to = make_number (start + this_to); + if (NILP (string)) + Fcompose_region_internal (from, to, gstr, Qnil); + else + Fcompose_string_internal (string, from, to, gstr, Qnil); + } + else + i = j; + } + + return to; +} + +DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0, + doc: /* Apply OpenType features on glyph-string GSTRING-IN. +OTF-SPEC specifies which featuress to apply in this format: + (SCRIPT LANGSYS GSUB GPOS) +where + SCRIPT is a symbol specifying a script tag of OpenType, + LANGSYS is a symbol specifying a langsys tag of OpenType, + GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags. + +If LANGYS is nil, the default langsys is selected. + +The features are applied in the order appeared in the list. The +symbol `*' means to apply all available features not appeared in this +list, and the remaining features are ignored. For instance, (vatu +pstf * haln) is to apply vatu and pstf in this order, then to apply +all available features other than vatu, pstf, and haln. + +The features are applied to the glyphs in the range FROM and TO of +the glyph-string GSTRING-IN. + +If some of a feature is actually applicable, the resulting glyphs are +produced in the glyph-string GSTRING-OUT from the index INDEX. In +this case, the value is the number of produced glyphs. + +If no feature is applicable, no glyph is produced in GSTRING-OUT, and +the value is 0. + +If GSTRING-OUT is too short to hold produced glyphs, no glyphs is +produced in GSTRING-OUT, and the value is nil. + +See the documentation of `font-make-gstring' for the format of +glyph-string. */) + (otf_features, gstring_in, from, to, gstring_out, index) + Lisp_Object otf_features, gstring_in, from, to, gstring_out, index; +{ + Lisp_Object font_object = LGSTRING_FONT (gstring_in); + Lisp_Object val; + struct font *font; + int len, num; + + check_otf_features (otf_features); + CHECK_FONT_GET_OBJECT (font_object, font); + if (! font->driver->otf_drive) + error ("Font backend %s can't drive OpenType GSUB table", + SDATA (SYMBOL_NAME (font->driver->type))); + CHECK_CONS (otf_features); + CHECK_SYMBOL (XCAR (otf_features)); + val = XCDR (otf_features); + CHECK_SYMBOL (XCAR (val)); + val = XCDR (otf_features); + if (! NILP (val)) + CHECK_CONS (val); + len = check_gstring (gstring_in); + CHECK_VECTOR (gstring_out); + CHECK_NATNUM (from); + CHECK_NATNUM (to); + CHECK_NATNUM (index); + + if (XINT (from) >= XINT (to) || XINT (to) > len) + args_out_of_range_3 (from, to, make_number (len)); + if (XINT (index) >= ASIZE (gstring_out)) + args_out_of_range (index, make_number (ASIZE (gstring_out))); + num = font->driver->otf_drive (font, otf_features, + gstring_in, XINT (from), XINT (to), + gstring_out, XINT (index), 0); + if (num < 0) + return Qnil; + return make_number (num); +} + +DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates, + 3, 3, 0, + doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT. +FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply +in this format: + (SCRIPT LANGSYS FEATURE ...) +See the documentation of `font-otf-gsub' for more detail. + +The value is a list of cons cells of the format (GLYPH-ID . CHARACTER), +where GLYPH-ID is a glyph index of the font, and CHARACTER is a +character code corresponding to the glyph or nil if there's no +corresponding character. */) + (font_object, character, otf_features) + Lisp_Object font_object, character, otf_features; +{ + struct font *font; + Lisp_Object gstring_in, gstring_out, g; + Lisp_Object alternates; + int i, num; + + CHECK_FONT_GET_OBJECT (font_object, font); + if (! font->driver->otf_drive) + error ("Font backend %s can't drive OpenType GSUB table", + SDATA (SYMBOL_NAME (font->driver->type))); + CHECK_CHARACTER (character); + CHECK_CONS (otf_features); + + gstring_in = Ffont_make_gstring (font_object, make_number (1)); + g = LGSTRING_GLYPH (gstring_in, 0); + LGLYPH_SET_CHAR (g, character); + gstring_out = Ffont_make_gstring (font_object, make_number (10)); + while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1, + gstring_out, 0, 1)) < 0) + gstring_out = Ffont_make_gstring (font_object, + make_number (ASIZE (gstring_out) * 2)); + alternates = Qnil; + for (i = 0; i < num; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring_out, i); + int c = XINT (LGLYPH_CHAR (g)); + unsigned code = XUINT (LGLYPH_CODE (g)); + + alternates = Fcons (Fcons (make_number (code), + c > 0 ? make_number (c) : Qnil), + alternates); + } + return Fnreverse (alternates); +} + + +#ifdef FONT_DEBUG + +DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, + doc: /* Open FONT-ENTITY. */) + (font_entity, size, frame) + Lisp_Object font_entity; + Lisp_Object size; + Lisp_Object frame; +{ + int isize; + + CHECK_FONT_ENTITY (font_entity); + if (NILP (size)) + size = AREF (font_entity, FONT_SIZE_INDEX); + CHECK_NUMBER (size); + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + + isize = XINT (size); + if (isize == 0) + isize = 120; + if (isize < 0) + isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy); + + return font_open_entity (XFRAME (frame), font_entity, isize); +} + +DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0, + doc: /* Close FONT-OBJECT. */) + (font_object, frame) + Lisp_Object font_object, frame; +{ + CHECK_FONT_OBJECT (font_object); + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + font_close_object (XFRAME (frame), font_object); + return Qnil; +} + +DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0, + doc: /* Return information about FONT-OBJECT. +The value is a vector: + [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH + CAPABILITY ] + +NAME is a string of the font name (or nil if the font backend doesn't +provide a name). + +FILENAME is a string of the font file (or nil if the font backend +doesn't provide a file name). + +PIXEL-SIZE is a pixel size by which the font is opened. + +SIZE is a maximum advance width of the font in pixel. + +ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in +pixel. + +CAPABILITY is a list whose first element is a symbol representing the +font format \(x, opentype, truetype, type1, pcf, or bdf) and the +remaining elements describes a detail of the font capability. + +If the font is OpenType font, the form of the list is + \(opentype GSUB GPOS) +where GSUB shows which "GSUB" features the font supports, and GPOS +shows which "GPOS" features the font supports. Both GSUB and GPOS are +lists of the format: + \((SCRIPT (LANGSYS FEATURE ...) ...) ...) + +If the font is not OpenType font, currently the length of the form is +one. + +SCRIPT is a symbol representing OpenType script tag. + +LANGSYS is a symbol representing OpenType langsys tag, or nil +representing the default langsys. + +FEATURE is a symbol representing OpenType feature tag. + +If the font is not OpenType font, OTF-CAPABILITY is nil. */) + (font_object) + Lisp_Object font_object; +{ + struct font *font; + Lisp_Object val; + + CHECK_FONT_GET_OBJECT (font_object, font); + + val = Fmake_vector (make_number (9), Qnil); + if (font->font.full_name) + ASET (val, 0, make_unibyte_string (font->font.full_name, + strlen (font->font.full_name))); + if (font->file_name) + ASET (val, 1, make_unibyte_string (font->file_name, + strlen (font->file_name))); + ASET (val, 2, make_number (font->pixel_size)); + ASET (val, 3, make_number (font->font.size)); + ASET (val, 4, make_number (font->ascent)); + ASET (val, 5, make_number (font->descent)); + ASET (val, 6, make_number (font->font.space_width)); + ASET (val, 7, make_number (font->font.average_width)); + if (font->driver->otf_capability) + ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font))); + else + ASET (val, 8, Fcons (font->format, Qnil)); + return val; +} + +DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0, + doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING. +Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */) + (font_object, string) + Lisp_Object font_object, string; +{ + struct font *font; + int i, len; + Lisp_Object vec; + + CHECK_FONT_GET_OBJECT (font_object, font); + CHECK_STRING (string); + len = SCHARS (string); + vec = Fmake_vector (make_number (len), Qnil); + for (i = 0; i < len; i++) + { + Lisp_Object ch = Faref (string, make_number (i)); + Lisp_Object val; + int c = XINT (ch); + unsigned code; + struct font_metrics metrics; + + code = font->driver->encode_char (font, c); + if (code == FONT_INVALID_CODE) + continue; + val = Fmake_vector (make_number (6), Qnil); + if (code <= MOST_POSITIVE_FIXNUM) + ASET (val, 0, make_number (code)); + else + ASET (val, 0, Fcons (make_number (code >> 16), + make_number (code & 0xFFFF))); + font->driver->text_extents (font, &code, 1, &metrics); + ASET (val, 1, make_number (metrics.lbearing)); + ASET (val, 2, make_number (metrics.rbearing)); + ASET (val, 3, make_number (metrics.width)); + ASET (val, 4, make_number (metrics.ascent)); + ASET (val, 5, make_number (metrics.descent)); + ASET (vec, i, val); + } + return vec; +} + +DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0, + doc: /* Return t iff font-spec SPEC matches with FONT. +FONT is a font-spec, font-entity, or font-object. */) + (spec, font) + Lisp_Object spec, font; +{ + CHECK_FONT_SPEC (spec); + if (FONT_OBJECT_P (font)) + font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity; + else if (! FONT_ENTITY_P (font)) + CHECK_FONT_SPEC (font); + + return (font_match_p (spec, font) ? Qt : Qnil); +} + +DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0, + doc: /* Return a font-object for displaying a character at POSISTION. +Optional second arg WINDOW, if non-nil, is a window displaying +the current buffer. It defaults to the currently selected window. */) + (position, window, string) + Lisp_Object position, window, string; +{ + struct window *w; + EMACS_INT pos; + + if (NILP (string)) + { + CHECK_NUMBER_COERCE_MARKER (position); + pos = XINT (position); + if (pos < BEGV || pos >= ZV) + args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); + } + else + { + EMACS_INT len; + unsigned char *str; + + CHECK_NUMBER (position); + CHECK_STRING (string); + pos = XINT (position); + if (pos < 0 || pos >= SCHARS (string)) + args_out_of_range (string, position); + } + if (NILP (window)) + window = selected_window; + CHECK_LIVE_WINDOW (window); + w = XWINDOW (window); + + return font_at (-1, pos, NULL, w, string); +} + +#if 0 +DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0, + doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame. +The value is a number of glyphs drawn. +Type C-l to recover what previously shown. */) + (font_object, string) + Lisp_Object font_object, string; +{ + Lisp_Object frame = selected_frame; + FRAME_PTR f = XFRAME (frame); + struct font *font; + struct face *face; + int i, len, width; + unsigned *code; + + CHECK_FONT_GET_OBJECT (font_object, font); + CHECK_STRING (string); + len = SCHARS (string); + code = alloca (sizeof (unsigned) * len); + for (i = 0; i < len; i++) + { + Lisp_Object ch = Faref (string, make_number (i)); + Lisp_Object val; + int c = XINT (ch); + + code[i] = font->driver->encode_char (font, c); + if (code[i] == FONT_INVALID_CODE) + break; + } + face = FACE_FROM_ID (f, DEFAULT_FACE_ID); + face->fontp = font; + if (font->driver->prepare_face) + font->driver->prepare_face (f, face); + width = font->driver->text_extents (font, code, i, NULL); + len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width); + if (font->driver->done_face) + font->driver->done_face (f, face); + face->fontp = NULL; + return make_number (len); +} +#endif + +#endif /* FONT_DEBUG */ + + +extern void syms_of_ftfont P_ (()); +extern void syms_of_xfont P_ (()); +extern void syms_of_xftfont P_ (()); +extern void syms_of_ftxfont P_ (()); +extern void syms_of_bdffont P_ (()); +extern void syms_of_w32font P_ (()); +extern void syms_of_atmfont P_ (()); + +void +syms_of_font () +{ + sort_shift_bits[FONT_SLANT_INDEX] = 0; + sort_shift_bits[FONT_WEIGHT_INDEX] = 7; + sort_shift_bits[FONT_SIZE_INDEX] = 14; + sort_shift_bits[FONT_WIDTH_INDEX] = 21; + sort_shift_bits[FONT_ADSTYLE_INDEX] = 28; + sort_shift_bits[FONT_FOUNDRY_INDEX] = 29; + sort_shift_bits[FONT_FAMILY_INDEX] = 30; + sort_shift_bits[FONT_REGISTRY_INDEX] = 31; + /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */ + + staticpro (&font_style_table); + font_style_table = Fmake_vector (make_number (3), Qnil); + + staticpro (&font_family_alist); + font_family_alist = Qnil; + + staticpro (&font_charset_alist); + font_charset_alist = Qnil; + + DEFSYM (Qopentype, "opentype"); + + DEFSYM (Qiso8859_1, "iso8859-1"); + DEFSYM (Qiso10646_1, "iso10646-1"); + DEFSYM (Qunicode_bmp, "unicode-bmp"); + DEFSYM (Qunicode_sip, "unicode-sip"); + + DEFSYM (QCotf, ":otf"); + DEFSYM (QClanguage, ":language"); + DEFSYM (QCscript, ":script"); + DEFSYM (QCantialias, ":antialias"); + + DEFSYM (QCfoundry, ":foundry"); + DEFSYM (QCadstyle, ":adstyle"); + DEFSYM (QCregistry, ":registry"); + DEFSYM (QCspacing, ":spacing"); + DEFSYM (QCdpi, ":dpi"); + DEFSYM (QCscalable, ":scalable"); + DEFSYM (QCextra, ":extra"); + + DEFSYM (Qc, "c"); + DEFSYM (Qm, "m"); + DEFSYM (Qp, "p"); + DEFSYM (Qd, "d"); + + staticpro (&null_string); + null_string = build_string (""); + staticpro (&null_vector); + null_vector = Fmake_vector (make_number (0), Qnil); + + staticpro (&scratch_font_spec); + scratch_font_spec = Ffont_spec (0, NULL); + staticpro (&scratch_font_prefer); + scratch_font_prefer = Ffont_spec (0, NULL); + +#ifdef HAVE_LIBOTF + staticpro (&otf_list); + otf_list = Qnil; +#endif + + defsubr (&Sfontp); + defsubr (&Sfont_spec); + defsubr (&Sfont_get); + defsubr (&Sfont_put); + defsubr (&Slist_fonts); + defsubr (&Slist_families); + defsubr (&Sfind_font); + defsubr (&Sfont_xlfd_name); + defsubr (&Sclear_font_cache); + defsubr (&Sinternal_set_font_style_table); + defsubr (&Sfont_make_gstring); + defsubr (&Sfont_fill_gstring); + defsubr (&Sfont_shape_text); + defsubr (&Sfont_drive_otf); + defsubr (&Sfont_otf_alternates); + +#ifdef FONT_DEBUG + defsubr (&Sopen_font); + defsubr (&Sclose_font); + defsubr (&Squery_font); + defsubr (&Sget_font_glyphs); + defsubr (&Sfont_match_p); + defsubr (&Sfont_at); +#if 0 + defsubr (&Sdraw_string); +#endif +#endif /* FONT_DEBUG */ + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { +#ifdef HAVE_FREETYPE + syms_of_ftfont (); +#ifdef HAVE_X_WINDOWS + syms_of_xfont (); + syms_of_ftxfont (); +#ifdef HAVE_XFT + syms_of_xftfont (); +#endif /* HAVE_XFT */ +#endif /* HAVE_X_WINDOWS */ +#else /* not HAVE_FREETYPE */ +#ifdef HAVE_X_WINDOWS + syms_of_xfont (); +#endif /* HAVE_X_WINDOWS */ +#endif /* not HAVE_FREETYPE */ +#ifdef HAVE_BDFFONT + syms_of_bdffont (); +#endif /* HAVE_BDFFONT */ +#ifdef WINDOWSNT + syms_of_w32font (); +#endif /* WINDOWSNT */ +#ifdef MAC_OS + syms_of_atmfont (); +#endif /* MAC_OS */ + } +#endif /* USE_FONT_BACKEND */ +} + +/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846 + (do not change this comment) */ diff --git a/src/font.h b/src/font.h new file mode 100644 index 00000000000..2433cdb0d34 --- /dev/null +++ b/src/font.h @@ -0,0 +1,582 @@ +/* font.h -- Interface definition for font handling. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#ifndef EMACS_FONT_H +#define EMACS_FONT_H + +#include "ccl.h" + +/* We have three types of Lisp objects related to font. + + FONT-SPEC + + Vector (length FONT_SPEC_MAX) of font properties. Some + properties can be left unspecified (i.e. nil). Emacs asks + font-drivers to find a font by FONT-SPEC. A fontset entry + specifies requisite properties whereas a face specifies just + preferable properties. This object is fully modifiable by + Lisp. + + FONT-ENTITY + + Vector (length FONT_ENTITY_MAX) of fully specified font + properties that a font-driver returns upon a request of + FONT-SPEC. + + Note: Only the method `list' of a font-driver can create this + object, and should never be modified by Lisp. In that sense, + it may be cleaner to implement it as a Lisp object of a new + type (e.g. struct Lisp_Font). + + FONT-OBJECT + + Lisp object of type Lisp_Misc_Save_Value encapsulating a + pointer to "struct font". This corresponds to an opened font. + + Note: The note for FONT-ENTITY also applies to this. +*/ + + +struct font_driver; +struct font; + +/* An enumerator for each font property. This is used as an index to + the vector of FONT-SPEC and FONT-ENTITY. + + Note: The order is important and should not be changed. */ + +enum font_property_index + { + /* FONT-TYPE is a symbol indicating a font backend; currently `x', + `xft', `ftx', `freetype' are available on X and gdi on Windows. + For Windows, we `bdf' and `uniscribe' backends are in progress. + For Mac OS X, we need `atm'. */ + FONT_TYPE_INDEX, + + /* FONT-FOUNDRY is a foundry name (symbol). */ + FONT_FOUNDRY_INDEX, + + /* FONT-FAMILY is a family name (symbol). */ + FONT_FAMILY_INDEX, + + /* FONT-ADSTYLE is an additional style name (symbol). */ + FONT_ADSTYLE_INDEX, + + /* FONT-REGISTRY is a combination of a charset-registry and + charset0encoding name (symbol). */ + FONT_REGISTRY_INDEX, + + /* FONT-WEIGHT is a numeric value of weight (e.g. medium, bold) of + the font. The value is what defined by FC_WEIGHT_* in + fontconfig. */ + FONT_WEIGHT_INDEX, + + /* FONT-SLANT is a numeric value of slant (e.g. r, i, o) of the + font. The value is what defined by FC_SLANT_* in + fontconfig plus 100. */ + FONT_SLANT_INDEX, + + /* FONT-WIDTH is a numeric value of setwidth (e.g. normal, + condensed) of the font. The value is what defined by + FC_WIDTH_* in fontconfig. */ + FONT_WIDTH_INDEX, + + /* FONT-SIZE is a size of the font. If integer, it is a pixel + size. For a font-spec, the value can be float specifying a + point size. For a font-entity, the value can be zero meaning + that the font is scalable. */ + FONT_SIZE_INDEX, + + /* In a font-spec, the value is an alist of extra information of a + font such as name, OpenType features, and language coverage. + In a font-entity, the value is an extra infomation for + identifying a font (font-driver dependent). */ + FONT_EXTRA_INDEX, /* alist alist */ + + /* This value is the length of font-spec vector. */ + FONT_SPEC_MAX, + + /* The followings are used only for a font-entity. */ + + /* Frame on which the font is found. The value is nil if the font + can be opend on any frame. */ + FONT_FRAME_INDEX = FONT_SPEC_MAX, + + /* List of font-objects opened from the font-entity. The value is + nil if no font can be opened for this font-entity. */ + FONT_OBJLIST_INDEX, + + /* This value is the length of font-entity vector. */ + FONT_ENTITY_MAX + }; + +extern Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClanguage, QCscript; + +/* Important character set symbols. */ +extern Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip; + +extern Lisp_Object null_string; +extern Lisp_Object null_vector; + +/* Structure for an opened font. We can safely cast this structure to + "struct font_info". */ + +struct font +{ + struct font_info font; + + /* From which font-entity the font is opened. */ + Lisp_Object entity; + + /* By which pixel size the font is opened. */ + int pixel_size; + + /* Font-driver for the font. */ + struct font_driver *driver; + + /* Symbol of font font; x, ttf, pcf, etc, */ + Lisp_Object format; + + /* File name of the font, or NULL if the font is not associated with + a file. */ + char *file_name; + + /* Charset to encode a character code into a glyph code of the font. + -1 means that the font doesn't require this information to encode + a character. */ + int encoding_charset; + + /* Charset to check if a character code is supported by the font. + -1 means that the contents of the font must be looked up to + determine it. */ + int repertory_charset; + + /* Minimum glyph width (in pixels). */ + int min_width; + + /* Ascent and descent of the font (in pixels). */ + int ascent, descent; + + /* 1 iff the font is scalable. */ + int scalable; + + /* There will be more to this structure, but they are private to a + font-driver. */ +}; + +enum font_spacing + { + FONT_SPACING_PROPORTIONAL = 0, + FONT_SPACING_DUAL = 90, + FONT_SPACING_MONO = 100, + FONT_SPACING_CHARCELL = 110 + }; + +struct font_metrics +{ + short lbearing, rbearing, width, ascent, descent; +}; + +struct font_bitmap +{ + int bits_per_pixel; + int rows; + int width; + int pitch; + unsigned char *buffer; + int left; + int top; + int advance; + void *extra; +}; + +/* Predicates to check various font-related objects. */ + +#define FONTP(x) \ + (VECTORP (x) && (ASIZE (x) == FONT_SPEC_MAX || ASIZE (x) == FONT_ENTITY_MAX)) +#define FONT_SPEC_P(x) \ + (VECTORP (x) && ASIZE (x) == FONT_SPEC_MAX) +#define FONT_ENTITY_P(x) \ + (VECTORP (x) && ASIZE (x) == FONT_ENTITY_MAX) +#define FONT_OBJECT_P(x) \ + (XTYPE (x) == Lisp_Misc && XMISCTYPE (x) == Lisp_Misc_Save_Value) + +#define FONT_ENTITY_NOT_LOADABLE(entity) \ + EQ (AREF (entity, FONT_OBJLIST_INDEX), Qt) + +#define FONT_ENTITY_SET_NOT_LOADABLE(entity) \ + ASET (entity, FONT_OBJLIST_INDEX, Qt) + + +/* Check macros for various font-related objects. */ + +#define CHECK_FONT(x) \ + do { if (! FONTP (x)) x = wrong_type_argument (Qfont, x); } while (0) +#define CHECK_FONT_SPEC(x) \ + do { if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); } while (0) +#define CHECK_FONT_ENTITY(x) \ + do { if (! FONT_ENTITY_P (x)) x = wrong_type_argument (Qfont, x); } while (0) +#define CHECK_FONT_OBJECT(x) \ + do { if (! FONT_OBJECT_P (x)) x = wrong_type_argument (Qfont, x); } while (0) + +#define CHECK_FONT_GET_OBJECT(x, font) \ + do { \ + if (! FONT_OBJECT_P (x)) x = wrong_type_argument (Qfont, x); \ + if (! XSAVE_VALUE (x)->pointer) error ("Font already closed"); \ + font = XSAVE_VALUE (x)->pointer; \ + } while (0) + +/* Ignore the difference of font pixel sizes less than or equal to + this value. */ +#define FONT_PIXEL_SIZE_QUANTUM 1 + +struct face; +struct composition; + +/* Macros for lispy glyph-string. */ +#define LGSTRING_FONT(lgs) AREF (AREF ((lgs), 0), 0) +#define LGSTRING_WIDTH(lgs) XINT (AREF (AREF ((lgs), 0), 1)) +#define LGSTRING_LBEARING(lgs) XINT (AREF (AREF ((lgs), 0), 2)) +#define LGSTRING_RBEARING(lgs) XINT (AREF (AREF ((lgs), 0), 3)) +#define LGSTRING_ASCENT(lgs) XINT (AREF (AREF ((lgs), 0), 4)) +#define LGSTRING_DESCENT(lgs) XINT (AREF (AREF ((lgs), 0), 5)) +#define LGSTRING_SET_FONT(lgs, val) \ + ASET (AREF ((lgs), 0), 0, (val)) +#define LGSTRING_SET_WIDTH(lgs, val) \ + ASET (AREF ((lgs), 0), 1, make_number (val)) +#define LGSTRING_SET_LBEARING(lgs, val) \ + ASET (AREF ((lgs), 0), 2, make_number (val)) +#define LGSTRING_SET_RBEARING(lgs, val) \ + ASET (AREF ((lgs), 0), 3, make_number (val)) +#define LGSTRING_SET_ASCENT(lgs, val) \ + ASET (AREF ((lgs), 0), 4, make_number (val)) +#define LGSTRING_SET_DESCENT(lgs, val) \ + ASET (AREF ((lgs), 0), 5, make_number (val)) + +#define LGSTRING_LENGTH(lgs) (ASIZE ((lgs)) - 1) +#define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 1) +#define LGSTRING_SET_GLYPH(lgs, idx, val) ASET ((lgs), (idx) + 1, (val)) + +/* Vector size of Lispy glyph. */ +#define LGLYPH_SIZE 10 +#define LGLYPH_FROM(g) XINT (AREF ((g), 0)) +#define LGLYPH_TO(g) XINT (AREF ((g), 1)) +#define LGLYPH_CHAR(g) XINT (AREF ((g), 2)) +#define LGLYPH_CODE(g) XINT (AREF ((g), 3)) +#define LGLYPH_WIDTH(g) XINT (AREF ((g), 4)) +#define LGLYPH_LBEARING(g) XINT (AREF ((g), 5)) +#define LGLYPH_RBEARING(g) XINT (AREF ((g), 6)) +#define LGLYPH_ASCENT(g) XINT (AREF ((g), 7)) +#define LGLYPH_DESCENT(g) XINT (AREF ((g), 8)) +#define LGLYPH_ADJUSTMENT(g) AREF ((g), 9) +#define LGLYPH_SET_FROM(g, val) ASET ((g), 0, make_number (val)) +#define LGLYPH_SET_TO(g, val) ASET ((g), 1, make_number (val)) +#define LGLYPH_SET_CHAR(g, val) ASET ((g), 2, make_number (val)) +#define LGLYPH_SET_CODE(g, val) ASET ((g), 3, make_number (val)) +#define LGLYPH_SET_WIDTH(g, val) ASET ((g), 4, make_number (val)) +#define LGLYPH_SET_LBEARING(g, val) ASET ((g), 5, make_number (val)) +#define LGLYPH_SET_RBEARING(g, val) ASET ((g), 6, make_number (val)) +#define LGLYPH_SET_ASCENT(g, val) ASET ((g), 7, make_number (val)) +#define LGLYPH_SET_DESCENT(g, val) ASET ((g), 8, make_number (val)) +#define LGLYPH_SET_ADJUSTMENT(g, val) ASET ((g), 9, (val)) + +#define LGLYPH_XOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \ + ? XINT (AREF (LGLYPH_ADJUSTMENT (g), 0)) : 0) +#define LGLYPH_YOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \ + ? XINT (AREF (LGLYPH_ADJUSTMENT (g), 1)) : 0) +#define LGLYPH_WADJUST(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \ + ? XINT (AREF (LGLYPH_ADJUSTMENT (g), 2)) : 0) + +#define FONT_INVALID_CODE 0xFFFFFFFF + +/* Font driver. Members specified as "optional" can be NULL. */ + +struct font_driver +{ + /* Symbol indicating the type of the font-driver. */ + Lisp_Object type; + + /* Return a cache of font-entities on frame F. The cache must be a + cons whose cdr part is the actual cache area. */ + Lisp_Object (*get_cache) P_ ((FRAME_PTR F)); + + /* List fonts exactly matching with FONT_SPEC on FRAME. The value + is a vector of font-entities. This is the sole API that + allocates font-entities. */ + Lisp_Object (*list) P_ ((Lisp_Object frame, Lisp_Object font_spec)); + + /* Return a font entity most closely maching with FONT_SPEC on + FRAME. The closeness is detemined by the font backend, thus + `face-font-selection-order' is ignored here. */ + Lisp_Object (*match) P_ ((Lisp_Object frame, Lisp_Object font_spec)); + + /* Optional. + List available families. The value is a list of family names + (symbols). */ + Lisp_Object (*list_family) P_ ((Lisp_Object frame)); + + /* Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value). + Free FONT_EXTRA_INDEX field of FONT_ENTITY. */ + void (*free_entity) P_ ((Lisp_Object font_entity)); + + /* Open a font specified by FONT_ENTITY on frame F. If the font is + scalable, open it with PIXEL_SIZE. */ + struct font *(*open) P_ ((FRAME_PTR f, Lisp_Object font_entity, + int pixel_size)); + + /* Close FONT on frame F. */ + void (*close) P_ ((FRAME_PTR f, struct font *font)); + + /* Optional (if FACE->extra is not used). + Prepare FACE for displaying characters by FONT on frame F by + storing some data in FACE->extra. If successful, return 0. + Otherwise, return -1. */ + int (*prepare_face) P_ ((FRAME_PTR f, struct face *face)); + + /* Optional. + Done FACE for displaying characters by FACE->font on frame F. */ + void (*done_face) P_ ((FRAME_PTR f, struct face *face)); + + /* Optional. + If FONT_ENTITY has a glyph for character C (Unicode code point), + return 1. If not, return 0. If a font must be opened to check + it, return -1. */ + int (*has_char) P_ ((Lisp_Object entity, int c)); + + /* Return a glyph code of FONT for characer C (Unicode code point). + If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */ + unsigned (*encode_char) P_ ((struct font *font, int c)); + + /* Computate the total metrics of the NGLYPHS glyphs specified by + the font FONT and the sequence of glyph codes CODE, and store the + result in METRICS. */ + int (*text_extents) P_ ((struct font *font, + unsigned *code, int nglyphs, + struct font_metrics *metrics)); + + /* Optional. + Draw glyphs between FROM and TO of S->char2b at (X Y) pixel + position of frame F with S->FACE and S->GC. If WITH_BACKGROUND + is nonzero, fill the background in advance. It is assured that + WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars). */ + int (*draw) P_ ((struct glyph_string *s, int from, int to, + int x, int y, int with_background)); + + /* Optional. + Store bitmap data for glyph-code CODE of FONT in BITMAP. It is + intended that this method is callled from the other font-driver + for actual drawing. */ + int (*get_bitmap) P_ ((struct font *font, unsigned code, + struct font_bitmap *bitmap, + int bits_per_pixel)); + + /* Optional. + Free bitmap data in BITMAP. */ + void (*free_bitmap) P_ ((struct font *font, struct font_bitmap *bitmap)); + + /* Optional. + Return an outline data for glyph-code CODE of FONT. The format + of the outline data depends on the font-driver. */ + void *(*get_outline) P_ ((struct font *font, unsigned code)); + + /* Optional. + Free OUTLINE (that is obtained by the above method). */ + void (*free_outline) P_ ((struct font *font, void *outline)); + + /* Optional. + Get coordinates of the INDEXth anchor point of the glyph whose + code is CODE. Store the coordinates in *X and *Y. Return 0 if + the operations was successfull. Otherwise return -1. */ + int (*anchor_point) P_ ((struct font *font, unsigned code, int index, + int *x, int *y)); + + /* Optional. + Return a list describing which scripts/languages FONT + supports by which GSUB/GPOS features of OpenType tables. */ + Lisp_Object (*otf_capability) P_ ((struct font *font)); + + /* Optional. + Apply FONT's OTF-FEATURES to the glyph string. + + FEATURES specifies which OTF features to apply in this format: + (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE) + See the documentation of `font-drive-otf' for the detail. + + This method applies the specified features to the codes in the + elements of GSTRING-IN (between FROMth and TOth). The output + codes are stored in GSTRING-OUT at the IDXth element and the + following elements. + + Return the number of output codes. If none of the features are + applicable to the input data, return 0. If GSTRING-OUT is too + short, return -1. */ + int (*otf_drive) P_ ((struct font *font, Lisp_Object features, + Lisp_Object gstring_in, int from, int to, + Lisp_Object gstring_out, int idx, int alternate_subst)); + + /* Optional. + Make the font driver ready for frame F. Usually this function + makes some data specific to F and store it in F by calling + font_put_frame_data (). */ + int (*start_for_frame) P_ ((FRAME_PTR f)); + + /* Optional. + End using the driver for frame F. Usually this function free + some data stored for F. */ + int (*end_for_frame) P_ ((FRAME_PTR f)); + + /* Optional. + + Shape text in LGSTRING. See the docstring of `font-make-gstring' + for the format of LGSTRING. If the (N+1)th element of LGSTRING + is nil, input of shaping is from the 1st to (N)th elements. In + each input glyph, FROM, TO, CHAR, and CODE are already set. + + This function updates all fields of the input glyphs. If the + output glyphs (M) are more than the input glyphs (N), (N+1)th + through (M)th elements of LGSTRING are updated possibly by making + a new glyph object and storing it in LGSTRING. If (M) is greater + than the length of LGSTRING, nil should be return. In that case, + this function is called again with the larger LGSTRING. */ + Lisp_Object (*shape) P_ ((Lisp_Object lgstring)); +}; + + +/* Chain of font drivers. There's one global font driver list + (font_driver_list in font.c). In addition, each frame has it's own + font driver list at FRAME_PTR->font_driver_list. */ + +struct font_driver_list +{ + /* 1 iff this driver is currently used. It is igonred in the global + font driver list.*/ + int on; + /* Pointer to the font driver. */ + struct font_driver *driver; + /* Pointer to the next element of the chain. */ + struct font_driver_list *next; +}; + + +/* Chain of arbitrary data specific to each font driver. Each frame + has it's own font data list at FRAME_PTR->font_data_list. */ + +struct font_data_list +{ + /* Pointer to the font driver. */ + struct font_driver *driver; + /* Data specific to the font driver. */ + void *data; + /* Pointer to the next element of the chain. */ + struct font_data_list *next; +}; + +extern int enable_font_backend; + +EXFUN (Ffont_spec, MANY); +EXFUN (Ffont_get, 2); +EXFUN (Flist_fonts, 4); +EXFUN (Fclear_font_cache, 0); +EXFUN (Ffont_xlfd_name, 1); + +extern int font_registry_charsets P_ ((Lisp_Object, struct charset **, + struct charset **)); +extern Lisp_Object font_symbolic_weight P_ ((Lisp_Object font)); +extern Lisp_Object font_symbolic_slant P_ ((Lisp_Object font)); +extern Lisp_Object font_symbolic_width P_ ((Lisp_Object font)); + +extern int font_match_p P_ ((Lisp_Object spec, Lisp_Object entity)); + +extern Lisp_Object font_find_object P_ ((struct font *font)); +extern Lisp_Object font_get_name P_ ((Lisp_Object font_object)); +extern Lisp_Object font_get_spec P_ ((Lisp_Object font_object)); +extern Lisp_Object font_get_frame P_ ((Lisp_Object font_object)); +extern int font_has_char P_ ((FRAME_PTR, Lisp_Object, int)); +extern unsigned font_encode_char P_ ((Lisp_Object, int)); + +extern int font_set_lface_from_name P_ ((FRAME_PTR f, + Lisp_Object lface, + Lisp_Object fontname, + int force_p, int may_fail_p)); +extern Lisp_Object font_find_for_lface P_ ((FRAME_PTR f, Lisp_Object *lface, + Lisp_Object spec, int c)); +extern Lisp_Object font_open_for_lface P_ ((FRAME_PTR f, Lisp_Object entity, + Lisp_Object *lface, + Lisp_Object spec)); +extern void font_load_for_face P_ ((FRAME_PTR f, struct face *face)); +extern void font_prepare_for_face P_ ((FRAME_PTR f, struct face *face)); +extern Lisp_Object font_open_by_name P_ ((FRAME_PTR f, char *name)); +extern void font_close_object (FRAME_PTR f, Lisp_Object font_object); + +extern Lisp_Object intern_downcase P_ ((char *str, int len)); +extern void font_update_sort_order P_ ((int *order)); + +extern void font_merge_old_spec P_ ((Lisp_Object name, Lisp_Object family, + Lisp_Object registry, Lisp_Object spec)); + + +extern int font_parse_xlfd P_ ((char *name, Lisp_Object font)); +extern int font_unparse_xlfd P_ ((Lisp_Object font, int pixel_size, + char *name, int bytes)); +extern int font_parse_fcname P_ ((char *name, Lisp_Object font)); +extern int font_unparse_fcname P_ ((Lisp_Object font, int pixel_size, + char *name, int bytes)); +extern void register_font_driver P_ ((struct font_driver *driver, FRAME_PTR f)); +extern void free_font_driver_list P_ ((FRAME_PTR f)); +extern Lisp_Object font_update_drivers P_ ((FRAME_PTR f, Lisp_Object list)); +extern Lisp_Object font_at P_ ((int c, EMACS_INT pos, struct face *face, + struct window *w, Lisp_Object object)); + +extern struct font *font_prepare_composition P_ ((struct composition *cmp, + FRAME_PTR f)); + +extern Lisp_Object font_put_extra P_ ((Lisp_Object font, Lisp_Object prop, + Lisp_Object val)); + +extern int font_put_frame_data P_ ((FRAME_PTR f, + struct font_driver *driver, + void *data)); +extern void *font_get_frame_data P_ ((FRAME_PTR f, + struct font_driver *driver)); + +#ifdef HAVE_FREETYPE +extern struct font_driver ftfont_driver; +#endif /* HAVE_FREETYPE */ +#ifdef HAVE_X_WINDOWS +extern struct font_driver xfont_driver; +extern struct font_driver ftxfont_driver; +#ifdef HAVE_XFT +extern struct font_driver xftfont_driver; +#endif /* HAVE_XFT */ +#endif /* HAVE_X_WINDOWS */ +#ifdef WINDOWSNT +extern struct font_driver w32font_driver; +#endif /* WINDOWSNT */ +#ifdef MAC_OS +extern struct font_driver atmfont_driver; +#endif /* MAC_OS */ + +#endif /* not EMACS_FONT_H */ + +/* arch-tag: 3b7260c3-5bec-4d6b-a0db-95c1b431b1a2 + (do not change this comment) */ diff --git a/src/fontset.c b/src/fontset.c index 2c0f0ac161c..085aadb1f0d 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -5,7 +5,10 @@ 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 - + Copyright (C) 2003, 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify @@ -32,12 +35,15 @@ Boston, MA 02110-1301, USA. */ #endif #include "lisp.h" +#include "blockinput.h" #include "buffer.h" +#include "character.h" #include "charset.h" #include "ccl.h" #include "keyboard.h" #include "frame.h" #include "dispextern.h" +#include "intervals.h" #include "fontset.h" #include "window.h" #ifdef HAVE_X_WINDOWS @@ -51,71 +57,130 @@ Boston, MA 02110-1301, USA. */ #endif #include "termhooks.h" -#ifdef FONTSET_DEBUG +#include "font.h" + #undef xassert +#ifdef FONTSET_DEBUG #define xassert(X) do {if (!(X)) abort ();} while (0) #undef INLINE #define INLINE -#endif +#else /* not FONTSET_DEBUG */ +#define xassert(X) (void) 0 +#endif /* not FONTSET_DEBUG */ +EXFUN (Fclear_face_cache, 1); /* FONTSET A fontset is a collection of font related information to give - similar appearance (style, size, etc) of characters. There are two - kinds of fontsets; base and realized. A base fontset is created by - new-fontset from Emacs Lisp explicitly. A realized fontset is - created implicitly when a face is realized for ASCII characters. A - face is also realized for multibyte characters based on an ASCII - face. All of the multibyte faces based on the same ASCII face - share the same realized fontset. + similar appearance (style, etc) of characters. A fontset has two + roles. One is to use for the frame parameter `font' as if it is an + ASCII font. In that case, Emacs uses the font specified for + `ascii' script for the frame's default font. + + Another role, the more important one, is to provide information + about which font to use for each non-ASCII character. + + There are two kinds of fontsets; base and realized. A base fontset + is created by `new-fontset' from Emacs Lisp explicitly. A realized + fontset is created implicitly when a face is realized for ASCII + characters. A face is also realized for non-ASCII characters based + on an ASCII face. All of non-ASCII faces based on the same ASCII + face share the same realized fontset. + + A fontset object is implemented by a char-table whose default value + and parent are always nil. + + An element of a base fontset is a vector of FONT-DEFs which itself + is a vector [ FONT-SPEC ENCODING REPERTORY ]. + + FONT-SPEC is a font-spec created by `font-spec' or + ( FAMILY . REGISTRY ) + or + FONT-NAME + where FAMILY, REGISTRY, and FONT-NAME are strings. + + ENCODING is a charset ID that can convert characters to glyph codes + of the corresponding font. + + REPERTORY is a charset ID, a char-table, or nil. If REPERTORY is a + charset ID, the repertory of the charset exactly matches with that + of the font. If REPERTORY is a char-table, all characters who have + a non-nil value in the table are supported. If REPERTORY is nil, + we consult with the font itself to get the repertory. + + ENCODING and REPERTORY are extracted from the variable + Vfont_encoding_alist by using a font name generated from FONT-SPEC + (if it is a vector) or FONT-NAME as a matching target. + + + An element of a realized fontset is nil or t, or has this form: + + [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-FAMILY + RFONT-DEF0 RFONT-DEF1 ...]. + + RFONT-DEFn (i.e. Realized FONT-DEF) has this form: + + [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ] + + RFONT-DEFn is automatically reordered by the current charset + priority list. - A fontset object is implemented by a char-table. + The value nil means that we have not yet generated the above vector + from the base of the fontset. - An element of a base fontset is: - (INDEX . FONTNAME) or - (INDEX . (FOUNDRY . REGISTRY )) - FONTNAME is a font name pattern for the corresponding character. - FOUNDRY and REGISTRY are respectively foundry and registry fields of - a font name for the corresponding character. INDEX specifies for - which character (or generic character) the element is defined. It - may be different from an index to access this element. For - instance, if a fontset defines some font for all characters of - charset `japanese-jisx0208', INDEX is the generic character of this - charset. REGISTRY is the + The value t means that no font is available for the corresponding + range of characters. - An element of a realized fontset is FACE-ID which is a face to use - for displaying the corresponding character. - All single byte characters (ASCII and 8bit-unibyte) share the same - element in a fontset. The element is stored in the first element - of the fontset. + A fontset has 9 extra slots. - To access or set each element, use macros FONTSET_REF and - FONTSET_SET respectively for efficiency. + The 1st slot: the ID number of the fontset - A fontset has 3 extra slots. + The 2nd slot: + base: the name of the fontset + realized: nil - The 1st slot is an ID number of the fontset. + The 3rd slot: + base: nil + realized: the base fontset - The 2nd slot is a name of the fontset. This is nil for a realized - face. + The 4th slot: + base: nil + realized: the frame that the fontset belongs to - The 3rd slot is a frame that the fontset belongs to. This is nil - for a default face. + The 5th slot: + base: the font name for ASCII characters + realized: nil - A parent of a base fontset is nil. A parent of a realized fontset - is a base fontset. + The 6th slot: + base: nil + realized: the ID number of a face to use for characters that + has no font in a realized fontset. - All fontsets are recorded in Vfontset_table. + The 7th slot: + base: nil + realized: Alist of font index vs the corresponding repertory + char-table. + + The 8th slot: + base: nil + realized: If the base is not the default fontset, a fontset + realized from the default fontset, else nil. + + The 9th slot: + base: Same as element value (but for fallback fonts). + realized: Likewise. + + All fontsets are recorded in the vector Vfontset_table. DEFAULT FONTSET - There's a special fontset named `default fontset' which defines a - default fontname pattern. When a base fontset doesn't specify a - font for a specific character, the corresponding value in the - default fontset is used. The format is the same as a base fontset. + There's a special base fontset named `default fontset' which + defines the default font specifications. When a base fontset + doesn't specify a font for a specific character, the corresponding + value in the default fontset is used. The parent of a realized fontset created for such a face that has no fontset is the default fontset. @@ -123,16 +188,19 @@ Boston, MA 02110-1301, USA. */ These structures are hidden from the other codes than this file. The other codes handle fontsets only by their ID numbers. They - usually use variable name `fontset' for IDs. But, in this file, we - always use variable name `id' for IDs, and name `fontset' for the - actual fontset objects. + usually use the variable name `fontset' for IDs. But, in this + file, we always use varialbe name `id' for IDs, and name `fontset' + for an actual fontset object, i.e., char-table. */ /********** VARIABLES and FUNCTION PROTOTYPES **********/ extern Lisp_Object Qfont; -Lisp_Object Qfontset; +static Lisp_Object Qfontset; +static Lisp_Object Qfontset_info; +static Lisp_Object Qprepend, Qappend; +static Lisp_Object Qlatin; /* Vector containing all fontsets. */ static Lisp_Object Vfontset_table; @@ -142,19 +210,17 @@ static Lisp_Object Vfontset_table; static int next_fontset_id; /* The default fontset. This gives default FAMILY and REGISTRY of - font for each characters. */ + font for each character. */ static Lisp_Object Vdefault_fontset; -/* Alist of font specifications. It override the font specification - in the default fontset. */ -static Lisp_Object Voverriding_fontspec_alist; - Lisp_Object Vfont_encoding_alist; +Lisp_Object Vfont_encoding_charset_alist; Lisp_Object Vuse_default_ascent; Lisp_Object Vignore_relative_composition; Lisp_Object Valternate_fontname_alist; Lisp_Object Vfontset_alias_alist; Lisp_Object Vvertical_centering_font_regexp; +Lisp_Object Votf_script_alist; /* The following six are declarations of callback functions depending on window system. See the comments in src/fontset.h for more @@ -187,19 +253,39 @@ void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg, This function set the member `encoder' of the structure. */ void (*find_ccl_program_func) P_ ((struct font_info *)); +Lisp_Object (*get_font_repertory_func) P_ ((struct frame *, + struct font_info *)); + /* Check if any window system is used now. */ void (*check_window_system_func) P_ ((void)); /* Prototype declarations for static functions. */ -static Lisp_Object fontset_ref P_ ((Lisp_Object, int)); -static Lisp_Object lookup_overriding_fontspec P_ ((Lisp_Object, int)); -static void fontset_set P_ ((Lisp_Object, int, Lisp_Object)); +static Lisp_Object fontset_add P_ ((Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object)); +static void reorder_font_vector P_ ((Lisp_Object, int, Lisp_Object)); +static Lisp_Object fontset_font P_ ((Lisp_Object, int, struct face *, int)); static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); -static int fontset_id_valid_p P_ ((int)); static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object)); -static Lisp_Object font_family_registry P_ ((Lisp_Object, int)); -static Lisp_Object regularize_fontname P_ ((Lisp_Object)); +static void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object, + Lisp_Object)); +Lisp_Object find_font_encoding P_ ((Lisp_Object)); + +static void set_fontset_font P_ ((Lisp_Object, Lisp_Object)); + +#ifdef FONTSET_DEBUG + +/* Return 1 if ID is a valid fontset id, else return 0. */ + +static int +fontset_id_valid_p (id) + int id; +{ + return (id >= 0 && id < ASIZE (Vfontset_table) - 1); +} + +#endif + /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/ @@ -209,170 +295,577 @@ static Lisp_Object regularize_fontname P_ ((Lisp_Object)); /* Macros to access special values of FONTSET. */ #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0] + +/* Macros to access special values of (base) FONTSET. */ #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1] -#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2] -#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0] -#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent +#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4] + +/* Macros to access special values of (realized) FONTSET. */ +#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2] +#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3] +#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5] +#define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6] +#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7] + +/* For both base and realized fontset. */ +#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8] -#define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset)) +#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset))) -/* Return the element of FONTSET (char-table) at index C (character). */ +/* Return the element of FONTSET for the character C. If FONTSET is a + base fontset other then the default fontset and FONTSET doesn't + contain information for C, return the information in the default + fontset. */ -#define FONTSET_REF(fontset, c) fontset_ref (fontset, c) +#define FONTSET_REF(fontset, c) \ + (EQ (fontset, Vdefault_fontset) \ + ? CHAR_TABLE_REF (fontset, c) \ + : fontset_ref ((fontset), (c))) static Lisp_Object fontset_ref (fontset, c) Lisp_Object fontset; int c; { - int charset, c1, c2; - Lisp_Object elt, defalt; - - if (SINGLE_BYTE_CHAR_P (c)) - return FONTSET_ASCII (fontset); - - SPLIT_CHAR (c, charset, c1, c2); - elt = XCHAR_TABLE (fontset)->contents[charset + 128]; - if (!SUB_CHAR_TABLE_P (elt)) - return elt; - defalt = XCHAR_TABLE (elt)->defalt; - if (c1 < 32 - || (elt = XCHAR_TABLE (elt)->contents[c1], - NILP (elt))) - return defalt; - if (!SUB_CHAR_TABLE_P (elt)) - return elt; - defalt = XCHAR_TABLE (elt)->defalt; - if (c2 < 32 - || (elt = XCHAR_TABLE (elt)->contents[c2], - NILP (elt))) - return defalt; + Lisp_Object elt; + + elt = CHAR_TABLE_REF (fontset, c); + if (NILP (elt) && ! EQ (fontset, Vdefault_fontset) + /* Don't check Vdefault_fontset for a realized fontset. */ + && NILP (FONTSET_BASE (fontset))) + elt = CHAR_TABLE_REF (Vdefault_fontset, c); return elt; } +/* Return the element of FONTSET for the character C, set FROM and TO + to the range of characters around C that have the same value as C. + If FONTSET is a base fontset other then the default fontset and + FONTSET doesn't contain information for C, return the information + in the default fontset. */ + +#define FONTSET_REF_AND_RANGE(fontset, c, form, to) \ + (EQ (fontset, Vdefault_fontset) \ + ? char_table_ref_and_range (fontset, c, &from, &to) \ + : fontset_ref_and_range (fontset, c, &from, &to)) + static Lisp_Object -lookup_overriding_fontspec (frame, c) - Lisp_Object frame; +fontset_ref_and_range (fontset, c, from, to) + Lisp_Object fontset; int c; + int *from, *to; { - Lisp_Object tail; + Lisp_Object elt; - for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail)) + elt = char_table_ref_and_range (fontset, c, from, to); + if (NILP (elt) && ! EQ (fontset, Vdefault_fontset) + /* Don't check Vdefault_fontset for a realized fontset. */ + && NILP (FONTSET_BASE (fontset))) { - Lisp_Object val, target, elt; - - val = XCAR (tail); - target = XCAR (val); - val = XCDR (val); - /* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME). */ - if (NILP (Fmemq (frame, XCAR (val))) - && (CHAR_TABLE_P (target) - ? ! NILP (CHAR_TABLE_REF (target, c)) - : XINT (target) == CHAR_CHARSET (c))) - { - val = XCDR (val); - elt = XCDR (val); - if (NILP (Fmemq (frame, XCAR (val)))) - { - if (! face_font_available_p (XFRAME (frame), XCDR (elt))) - { - val = XCDR (XCAR (tail)); - XSETCAR (val, Fcons (frame, XCAR (val))); - continue; - } - XSETCAR (val, Fcons (frame, XCAR (val))); - } - if (NILP (XCAR (elt))) - XSETCAR (elt, make_number (c)); - return elt; - } + int from1, to1; + + elt = char_table_ref_and_range (Vdefault_fontset, c, &from1, &to1); + if (*from < from1) + *from = from1; + if (*to > to1) + *to = to1; } - return Qnil; + return elt; } -#define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c) + +/* Set elements of FONTSET for characters in RANGE to the value ELT. + RANGE is a cons (FROM . TO), where FROM and TO are character codes + specifying a range. */ + +#define FONTSET_SET(fontset, range, elt) \ + Fset_char_table_range ((fontset), (range), (elt)) + + +/* Modify the elements of FONTSET for characters in RANGE by replacing + with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM + and TO are character codes specifying a range. If ADD is nil, + replace with ELT, if ADD is `prepend', prepend ELT, otherwise, + append ELT. */ + +#define FONTSET_ADD(fontset, range, elt, add) \ + (NILP (add) \ + ? (NILP (range) \ + ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \ + : Fset_char_table_range ((fontset), (range), \ + Fmake_vector (make_number (1), (elt)))) \ + : fontset_add ((fontset), (range), (elt), (add))) static Lisp_Object -fontset_ref_via_base (fontset, c) - Lisp_Object fontset; - int *c; +fontset_add (fontset, range, elt, add) + Lisp_Object fontset, range, elt, add; { - int charset, c1, c2; - Lisp_Object elt; + Lisp_Object args[2]; + int idx = (EQ (add, Qappend) ? 0 : 1); - if (SINGLE_BYTE_CHAR_P (*c)) - return FONTSET_ASCII (fontset); - - elt = Qnil; - if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset)) - elt = FONTSET_REF (FONTSET_BASE (fontset), *c); - if (NILP (elt)) - elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c); - if (NILP (elt)) - elt = FONTSET_REF (Vdefault_fontset, *c); - if (NILP (elt)) - return Qnil; + args[1 - idx] = Fmake_vector (make_number (1), elt); - *c = XINT (XCAR (elt)); - SPLIT_CHAR (*c, charset, c1, c2); - elt = XCHAR_TABLE (fontset)->contents[charset + 128]; - if (c1 < 32) - return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt); - if (!SUB_CHAR_TABLE_P (elt)) - return Qnil; - elt = XCHAR_TABLE (elt)->contents[c1]; - if (c2 < 32) - return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt); - if (!SUB_CHAR_TABLE_P (elt)) - return Qnil; - elt = XCHAR_TABLE (elt)->contents[c2]; - return elt; + if (CONSP (range)) + { + int from = XINT (XCAR (range)); + int to = XINT (XCDR (range)); + int from1, to1; + + do { + args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1); + if (to < to1) + to1 = to; + char_table_set_range (fontset, from, to1, + NILP (args[idx]) ? args[1 - idx] + : Fvconcat (2, args)); + from = to1 + 1; + } while (from < to); + } + else + { + args[idx] = FONTSET_FALLBACK (fontset); + FONTSET_FALLBACK (fontset) + = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args); + } + return Qnil; } -/* Store into the element of FONTSET at index C the value NEWELT. */ -#define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt) +/* Update FONT-GROUP which has this form: + [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-FAMILY + RFONT-DEF0 RFONT-DEF1 ...]. + Reorder RFONT-DEFs according to the current order of charset + (Vcharset_ordered_list), and update CHARSET-ORDERED-LIST-TICK to + the latest value. */ static void -fontset_set (fontset, c, newelt) +reorder_font_vector (font_group, charset_id, family) + Lisp_Object font_group; + int charset_id; + Lisp_Object family; +{ + Lisp_Object list, *new_vec; + int size; + int *charset_id_table; + int i, idx; + Lisp_Object preferred_by_charset, preferred_by_family; + + size = ASIZE (font_group) - 3; + charset_id_table = (int *) alloca (sizeof (int) * size); + new_vec = (Lisp_Object *) alloca (sizeof (Lisp_Object) * size); + + /* At first, extract ENCODING (a chaset ID) from RFONT_DEF which + has this form: + [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] + In addtion, if RFONT_DEF is preferred by family or charset, store + it from the start of new_vec. */ + for (i = 0, idx = 0; i < size; i++) + { + Lisp_Object rfont_def = AREF (font_group, i + 3); + Lisp_Object font_spec = AREF (AREF (rfont_def, 2), 0); + Lisp_Object this_family = AREF (font_spec, FONT_FAMILY_INDEX); + int id = XINT (AREF (AREF (rfont_def, 2), 1)); + struct charset *charset = CHARSET_FROM_ID (id); + + charset_id_table[i] = -1; + if (! NILP (this_family) + && (fast_string_match_ignore_case (family, SYMBOL_NAME (this_family)) + >= 0)) + { + if (idx > 0) + memmove (new_vec + 1, new_vec, sizeof (Lisp_Object) * idx); + new_vec[0] = rfont_def; + idx++; + ASET (font_group, i + 3, Qnil); + } + else if (id == charset_id) + { + new_vec[idx++] = rfont_def; + ASET (font_group, i + 3, Qnil); + } + else if (! charset->supplementary_p) + charset_id_table[i] = id; + } + + if (idx == 0 + && (XINT (AREF (font_group, 0)) == charset_ordered_list_tick)) + /* No need of reordering. */ + return; + + ASET (font_group, 0, make_number (charset_ordered_list_tick)); + ASET (font_group, 1, make_number (charset_id)); + ASET (font_group, 2, family); + + /* Then, store the remaining RFONT-DEFs in NEW_VEC in the correct + order. */ + for (list = Vcharset_ordered_list; idx < size; list = XCDR (list)) + { + int id = XINT (XCAR (list)); + struct charset *charset = CHARSET_FROM_ID (id); + + if (charset->supplementary_p) + break; + for (i = 0; i < size; i++) + if (charset_id_table[i] == XINT (XCAR (list)) + && ! NILP (AREF (font_group, i + 2))) + { + new_vec[idx++] = AREF (font_group, i + 3); + ASET (font_group, i + 3, Qnil); + } + } + for (i = 0; i < size; i++) + if (! NILP (AREF (font_group, i + 3))) + new_vec[idx++] = AREF (font_group, i + 3); + + /* At last, update elements of FONT-GROUP. */ + for (i = 0; i < size; i++) + ASET (font_group, i + 3, new_vec[i]); +} + + +/* Load a font matching the font related attributes in FACE->lface and + font pattern in FONT_DEF of FONTSET, and return an index of the + font. FONT_DEF has this form: + [ FONT-SPEC ENCODING REPERTORY ] + If REPERTORY is nil, generate a char-table representing the font + repertory by looking into the font itself. */ + +extern Lisp_Object QCname; + +static int +load_font_get_repertory (f, face, font_def, fontset) + FRAME_PTR f; + struct face *face; + Lisp_Object font_def; Lisp_Object fontset; - int c; - Lisp_Object newelt; { - int charset, code[3]; - Lisp_Object *elt; - int i; + char *font_name; + struct font_info *font_info; + int charset; + Lisp_Object font_spec, name; + + font_spec = AREF (font_def, 0); + name = Ffont_get (font_spec, QCname); + if (! NILP (name)) + font_name = choose_face_font (f, face->lface, name, NULL); + else + font_name = choose_face_font (f, face->lface, font_spec, NULL); + charset = XINT (AREF (font_def, 1)); + if (! (font_info = fs_load_font (f, font_name, charset))) + return -1; + + if (NILP (AREF (font_def, 2)) + && NILP (Fassq (make_number (font_info->font_idx), + FONTSET_REPERTORY (fontset)))) + { + /* We must look into the font to get the correct repertory as a + char-table. */ + Lisp_Object repertory; + + repertory = (*get_font_repertory_func) (f, font_info); + FONTSET_REPERTORY (fontset) + = Fcons (Fcons (make_number (font_info->font_idx), repertory), + FONTSET_REPERTORY (fontset)); + } + + return font_info->font_idx; +} - if (SINGLE_BYTE_CHAR_P (c)) +static Lisp_Object fontset_find_font P_ ((Lisp_Object, int, struct face *, + int, int)); + +/* Return RFONT-DEF (vector) in the realized fontset FONTSET for the + character C. If the corresponding font is not yet opened, open it + (if FACE is not NULL) or return Qnil (if FACE is NULL). + If no proper font is found for C, return Qnil. + ID is a charset-id that must be preferred, or -1 meaning no + preference. + If FALLBACK is nonzero, search only fallback fonts. */ + +static Lisp_Object +fontset_find_font (fontset, c, face, id, fallback) + Lisp_Object fontset; + int c; + struct face *face; + int id, fallback; +{ + Lisp_Object base_fontset, elt, vec, font_def; + int i, from, to; + int font_idx; + FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset)); + + base_fontset = FONTSET_BASE (fontset); + if (! fallback) + vec = CHAR_TABLE_REF (fontset, c); + else + vec = FONTSET_FALLBACK (fontset); + if (NILP (vec)) { - FONTSET_ASCII (fontset) = newelt; - return; + Lisp_Object range; + + /* We have not yet decided a font for C. */ + if (! face) + return Qnil; + if (! fallback) + { + elt = FONTSET_REF_AND_RANGE (base_fontset, c, from, to); + range = Fcons (make_number (from), make_number (to)); + if (EQ (base_fontset, Vdefault_fontset)) + { + Lisp_Object script = CHAR_TABLE_REF (Vchar_script_table, c); + + if (! NILP (script)) + { + Lisp_Object font_spec = Ffont_spec (0, NULL); + Lisp_Object args[2], tmp; + + ASET (font_spec, FONT_REGISTRY_INDEX, Qiso10646_1); + ASET (font_spec, FONT_EXTRA_INDEX, + Fcons (Fcons (QCscript, script), Qnil)); + args[0] = elt; + tmp = Fmake_vector (make_number (3), Qnil); + ASET (tmp, 0, font_spec); + ASET (tmp, 1, CHARSET_SYMBOL_ID (Qunicode_bmp)); + args[1] = Fvector (1, &tmp); + elt = Fvconcat (2, args); + } + } + } + else + { + elt = FONTSET_FALLBACK (base_fontset); + } + if (NILP (elt)) + { + /* Qt means we have no font for characters of this range. */ + vec = Qt; + } + else + { + /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ], + where the first -1 is to force reordering of NEW-ELTn, + NEW-ELTn is [nil nil AREF (elt, n) nil]. */ + vec = Fmake_vector (make_number (ASIZE (elt) + 3), Qnil); + ASET (vec, 0, make_number (-1)); + ASET (vec, 1, make_number (-1)); + for (i = 0; i < ASIZE (elt); i++) + { + Lisp_Object tmp; + tmp = Fmake_vector (make_number (5), Qnil); + ASET (tmp, 2, AREF (elt, i)); + ASET (vec, i + 3, tmp); + } + } + /* Then store it in the fontset. */ + if (! fallback) + FONTSET_SET (fontset, range, vec); + else + FONTSET_FALLBACK (fontset) = vec; } + if (EQ (vec, Qt)) + return Qnil; - SPLIT_CHAR (c, charset, code[0], code[1]); - code[2] = 0; /* anchor */ - elt = &XCHAR_TABLE (fontset)->contents[charset + 128]; - for (i = 0; code[i] > 0; i++) + if (ASIZE (vec) > 4 + && (XINT (AREF (vec, 0)) != charset_ordered_list_tick + || (id >= 0 && XINT (AREF (vec, 1)) != id) + || NILP (Fequal (AREF (vec, 2), face->lface[LFACE_FAMILY_INDEX])))) + /* We have just created VEC, + or the charset priorities were changed, + or the preferred charset was changed, + or the preferred family was changed. */ + reorder_font_vector (vec, id, face->lface[LFACE_FAMILY_INDEX]); + + /* Find the first available font in the vector of RFONT-DEF. */ + for (i = 3; i < ASIZE (vec); i++) { - if (!SUB_CHAR_TABLE_P (*elt)) + elt = AREF (vec, i); + if (NILP (elt)) + continue; + /* ELT == [ FACE-ID FONT-INDEX FONT-DEF ... ] */ + if (INTEGERP (AREF (elt, 1)) && XINT (AREF (elt, 1)) < 0) + /* We couldn't open this font last time. */ + continue; + + if (!face && NILP (AREF (elt, 1))) + /* We have not yet opened the font. */ + return Qnil; + + font_def = AREF (elt, 2); + /* FONT_DEF == [ FONT-SPEC ENCODING REPERTORY ] */ + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) { - Lisp_Object val = *elt; - *elt = make_sub_char_table (Qnil); - XCHAR_TABLE (*elt)->defalt = val; + /* ELT == [ FACE-ID FONT-INDEX FONT-DEF FONT-LIST ] + where FONT-LIST is a list of font-entity or font-object. */ + Lisp_Object font_list = AREF (elt, 3), prev = Qnil; + Lisp_Object font_object; + int has_char; + + for (; CONSP (font_list); + prev = font_list, font_list = XCDR (font_list)) + { + font_object = XCAR (font_list); + if (! (FONT_ENTITY_P (font_object) + && FONT_ENTITY_NOT_LOADABLE (font_object)) + && (has_char = font_has_char (f, font_object, c)) != 0) + { + if (has_char < 0) + { + Lisp_Object obj = font_open_for_lface (f, font_object, + face->lface, Qnil); + if (NILP (obj)) + { + FONT_ENTITY_SET_NOT_LOADABLE (font_object); + continue; + } + font_object = obj; + XSETCAR (font_list, font_object); + if (! font_has_char (f, font_object, c)) + continue; + } + if (! NILP (prev)) + { + /* Move this element to the head. */ + XSETCDR (prev, XCDR (font_list)); + ASET (elt, 3, Fcons (XCAR (font_list), AREF (elt, 3))); + } + break; + } + } + if (NILP (font_list)) + { + Lisp_Object font_spec = AREF (font_def, 0); + Lisp_Object font_entity; + + font_entity = font_find_for_lface (f, face->lface, font_spec, c); + if (NILP (font_entity)) + continue; + font_list = Fcons (font_entity, AREF (elt, 3)); + ASET (elt, 3, font_list); + } + font_object = XCAR (font_list); + if (FONT_ENTITY_P (font_object)) + { + font_object = font_open_for_lface (f, font_object, + face->lface, Qnil); + if (NILP (font_object)) + { + FONT_ENTITY_SET_NOT_LOADABLE (XCAR (font_list)); + continue; + } + XSETCAR (font_list, font_object); + } + ASET (elt, 1, make_number (0)); } - elt = &XCHAR_TABLE (*elt)->contents[code[i]]; + else +#endif /* USE_FONT_BACKEND */ + + if (INTEGERP (AREF (font_def, 2))) + { + /* The repertory is specified by charset ID. */ + struct charset *charset + = CHARSET_FROM_ID (XINT (AREF (font_def, 2))); + + if (! CHAR_CHARSET_P (c, charset)) + /* This font can't display C. */ + continue; + } + else if (CHAR_TABLE_P (AREF (font_def, 2))) + { + /* The repertory is specified by a char table. */ + if (NILP (CHAR_TABLE_REF (AREF (font_def, 2), c))) + /* This font can't display C. */ + continue; + } + else + { + Lisp_Object slot; + + if (! INTEGERP (AREF (elt, 1))) + { + /* We have not yet opened a font matching this spec. + Open the best matching font now and register the + repertory. */ + struct font_info *font_info; + + font_idx = load_font_get_repertory (f, face, font_def, fontset); + ASET (elt, 1, make_number (font_idx)); + if (font_idx < 0) + /* This means that we couldn't find a font matching + FONT_DEF. */ + continue; + font_info = (*get_font_info_func) (f, font_idx); + ASET (elt, 3, build_string (font_info->full_name)); + } + + slot = Fassq (AREF (elt, 1), FONTSET_REPERTORY (fontset)); + xassert (CONSP (slot)); + if (NILP (CHAR_TABLE_REF (XCDR (slot), c))) + /* This font can't display C. */ + continue; + } + + /* Now we have decided to use this font spec to display C. */ + if (! INTEGERP (AREF (elt, 1))) + { + /* But not yet opened the best matching font. */ + struct font_info *font_info; + + font_idx = load_font_get_repertory (f, face, font_def, fontset); + ASET (elt, 1, make_number (font_idx)); + if (font_idx < 0) + /* Can't open it. Try the other one. */ + continue; + font_info = (*get_font_info_func) (f, font_idx); + ASET (elt, 3, build_string (font_info->full_name)); + } + + /* Now we have the opened font. */ + return elt; } - if (SUB_CHAR_TABLE_P (*elt)) - XCHAR_TABLE (*elt)->defalt = newelt; - else - *elt = newelt; + return Qnil; } +static Lisp_Object +fontset_font (fontset, c, face, id) + Lisp_Object fontset; + int c; + struct face *face; + int id; +{ + Lisp_Object rfont_def; + Lisp_Object base_fontset; + + /* Try a font-group for C. */ + rfont_def = fontset_find_font (fontset, c, face, id, 0); + if (! NILP (rfont_def)) + return rfont_def; + base_fontset = FONTSET_BASE (fontset); + /* Try a font-group for C of the default fontset. */ + if (! EQ (base_fontset, Vdefault_fontset)) + { + if (NILP (FONTSET_DEFAULT (fontset))) + FONTSET_DEFAULT (fontset) + = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset); + rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0); + } + if (! NILP (rfont_def)) + return rfont_def; + /* Try a fallback font-group. */ + rfont_def = fontset_find_font (fontset, c, face, id, 1); + if (! NILP (rfont_def)) + return rfont_def; + /* Try a fallback font-group of the default fontset . */ + if (! EQ (base_fontset, Vdefault_fontset)) + rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1); + return rfont_def; +} + /* Return a newly created fontset with NAME. If BASE is nil, make a - base fontset. Otherwise make a realized fontset whose parent is + base fontset. Otherwise make a realized fontset whose base is BASE. */ static Lisp_Object @@ -391,103 +884,105 @@ make_fontset (frame, name, base) while (!NILP (AREF (Vfontset_table, id))) id++; if (id + 1 == size) - Vfontset_table = larger_vector (Vfontset_table, size + 8, Qnil); + Vfontset_table = larger_vector (Vfontset_table, size + 32, Qnil); fontset = Fmake_char_table (Qfontset, Qnil); FONTSET_ID (fontset) = make_number (id); - FONTSET_NAME (fontset) = name; - FONTSET_FRAME (fontset) = frame; - FONTSET_BASE (fontset) = base; + if (NILP (base)) + { + FONTSET_NAME (fontset) = name; + } + else + { + FONTSET_NAME (fontset) = Qnil; + FONTSET_FRAME (fontset) = frame; + FONTSET_BASE (fontset) = base; + } - AREF (Vfontset_table, id) = fontset; + ASET (Vfontset_table, id, fontset); next_fontset_id = id + 1; return fontset; } -/* Return 1 if ID is a valid fontset id, else return 0. */ - -static INLINE int -fontset_id_valid_p (id) - int id; -{ - return (id >= 0 && id < ASIZE (Vfontset_table) - 1); -} - - -/* Extract `family' and `registry' string from FONTNAME and a cons of - them. Actually, `family' may also contain `foundry', `registry' - may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't - conform to XLFD nor explicitely specifies the other fields - (i.e. not using wildcard `*'), return FONTNAME. If FORCE is - nonzero, specifications of the other fields are ignored, and return - a cons as far as FONTNAME conform to XLFD. */ - -static Lisp_Object -font_family_registry (fontname, force) +/* Set the ASCII font of the default fontset to FONTNAME if that is + not yet set. */ +void +set_default_ascii_font (fontname) Lisp_Object fontname; - int force; { - Lisp_Object family, registry; - const char *p = SDATA (fontname); - const char *sep[15]; - int i = 0; - - while (*p && i < 15) - if (*p++ == '-') - { - if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-') - return fontname; - sep[i++] = p; - } - if (i != 14) - return fontname; + if (! STRINGP (FONTSET_ASCII (Vdefault_fontset))) + { + int id = fs_query_fontset (fontname, 2); - family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]); - registry = make_unibyte_string (sep[12], p - sep[12]); - return Fcons (family, registry); + if (id >= 0) + fontname = FONTSET_ASCII (FONTSET_FROM_ID (id)); + FONTSET_ASCII (Vdefault_fontset)= fontname; + } } -/********** INTERFACES TO xfaces.c and dispextern.h **********/ +/********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/ -/* Return name of the fontset with ID. */ +/* Return the name of the fontset who has ID. */ Lisp_Object fontset_name (id) int id; { Lisp_Object fontset; + fontset = FONTSET_FROM_ID (id); return FONTSET_NAME (fontset); } -/* Return ASCII font name of the fontset with ID. */ +/* Return the ASCII font name of the fontset who has ID. */ Lisp_Object fontset_ascii (id) int id; { Lisp_Object fontset, elt; + fontset= FONTSET_FROM_ID (id); elt = FONTSET_ASCII (fontset); - return XCDR (elt); +#ifdef USE_FONT_BACKEND + if (CONSP (elt)) + elt = XCAR (elt); +#endif /* USE_FONT_BACKEND */ + /* It is assured that ELT is always a string (i.e. fontname + pattern). */ + return elt; } -/* Free fontset of FACE. Called from free_realized_face. */ +/* Free fontset of FACE defined on frame F. Called from + free_realized_face. */ void free_face_fontset (f, face) FRAME_PTR f; struct face *face; { - if (fontset_id_valid_p (face->fontset)) + Lisp_Object fontset; + + fontset = AREF (Vfontset_table, face->fontset); + xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset)); + xassert (f == XFRAME (FONTSET_FRAME (fontset))); + ASET (Vfontset_table, face->fontset, Qnil); + if (face->fontset < next_fontset_id) + next_fontset_id = face->fontset; + if (! NILP (FONTSET_DEFAULT (fontset))) { - AREF (Vfontset_table, face->fontset) = Qnil; - if (face->fontset < next_fontset_id) + int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset))); + + fontset = AREF (Vfontset_table, id); + xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset)); + xassert (f == XFRAME (FONTSET_FRAME (fontset))); + ASET (Vfontset_table, id, Qnil); + if (id < next_fontset_id) next_fontset_id = face->fontset; } } @@ -495,57 +990,92 @@ free_face_fontset (f, face) /* Return 1 if FACE is suitable for displaying character C. Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P - when C is not a single byte character.. */ + when C is not an ASCII character. */ int face_suitable_for_char_p (face, c) struct face *face; int c; { - Lisp_Object fontset, elt; - - if (SINGLE_BYTE_CHAR_P (c)) - return (face == face->ascii_face); + Lisp_Object fontset, rfont_def; - xassert (fontset_id_valid_p (face->fontset)); fontset = FONTSET_FROM_ID (face->fontset); - xassert (!BASE_FONTSET_P (fontset)); - - elt = FONTSET_REF_VIA_BASE (fontset, c); - return (!NILP (elt) && face->id == XFASTINT (elt)); + rfont_def = fontset_font (fontset, c, NULL, -1); + return (VECTORP (rfont_def) + && INTEGERP (AREF (rfont_def, 0)) + && face->id == XINT (AREF (rfont_def, 0))); } /* Return ID of face suitable for displaying character C on frame F. - The selection of face is done based on the fontset of FACE. FACE - should already have been realized for ASCII characters. Called - from the macro FACE_FOR_CHAR when C is not a single byte character. */ + FACE must be reazlied for ASCII characters in advance. Called from + the macro FACE_FOR_CHAR. */ int -face_for_char (f, face, c) +face_for_char (f, face, c, pos, object) FRAME_PTR f; struct face *face; - int c; + int c, pos; + Lisp_Object object; { - Lisp_Object fontset, elt; + Lisp_Object fontset, charset, rfont_def; int face_id; + int id; + + if (ASCII_CHAR_P (c)) + return face->ascii_face->id; xassert (fontset_id_valid_p (face->fontset)); fontset = FONTSET_FROM_ID (face->fontset); xassert (!BASE_FONTSET_P (fontset)); + if (pos < 0) + id = -1; + else + { + charset = Fget_char_property (make_number (pos), Qcharset, object); + if (NILP (charset)) + id = -1; + else if (CHARSETP (charset)) + { + Lisp_Object val; + + val = assoc_no_quit (charset, Vfont_encoding_charset_alist); + if (CONSP (val) && CHARSETP (XCDR (val))) + charset = XCDR (val); + id = XINT (CHARSET_SYMBOL_ID (charset)); + } + } + rfont_def = fontset_font (fontset, c, face, id); + if (VECTORP (rfont_def)) + { +#ifdef USE_FONT_BACKEND + if (enable_font_backend + && NILP (AREF (rfont_def, 0))) + { + struct font *font = XSAVE_VALUE (XCAR (AREF (rfont_def, 3)))->pointer; - elt = FONTSET_REF_VIA_BASE (fontset, c); - if (!NILP (elt)) - return XINT (elt); + face_id = face_for_font (f, font, face); + ASET (rfont_def, 0, make_number (face_id)); + } + else +#endif /* USE_FONT_BACKEND */ + if (NILP (AREF (rfont_def, 0))) + { + /* We have not yet made a realized face that uses this font. */ + int font_idx = XINT (AREF (rfont_def, 1)); - /* No face is recorded for C in the fontset of FACE. Make a new - realized face for C that has the same fontset. */ - face_id = lookup_face (f, face->lface, c, face); + face_id = lookup_non_ascii_face (f, font_idx, face); + ASET (rfont_def, 0, make_number (face_id)); + } + return XINT (AREF (rfont_def, 0)); + } - /* Record the face ID in FONTSET at the same index as the - information in the base fontset. */ - FONTSET_SET (fontset, c, make_number (face_id)); - return face_id; + if (NILP (FONTSET_NOFONT_FACE (fontset))) + { + face_id = lookup_non_ascii_face (f, -1, face); + FONTSET_NOFONT_FACE (fontset) = make_number (face_id); + } + return XINT (FONTSET_NOFONT_FACE (fontset)); } @@ -555,9 +1085,10 @@ face_for_char (f, face, c) Called from realize_x_face. */ int -make_fontset_for_ascii_face (f, base_fontset_id) +make_fontset_for_ascii_face (f, base_fontset_id, face) FRAME_PTR f; int base_fontset_id; + struct face *face; { Lisp_Object base_fontset, fontset, frame; @@ -568,69 +1099,47 @@ make_fontset_for_ascii_face (f, base_fontset_id) if (!BASE_FONTSET_P (base_fontset)) base_fontset = FONTSET_BASE (base_fontset); xassert (BASE_FONTSET_P (base_fontset)); + if (! BASE_FONTSET_P (base_fontset)) + abort (); } else base_fontset = Vdefault_fontset; fontset = make_fontset (frame, Qnil, base_fontset); - return XINT (FONTSET_ID (fontset)); -} - - -/* Return the font name pattern for C that is recorded in the fontset - with ID. If a font name pattern is specified (instead of a cons of - family and registry), check if a font can be opened by that pattern - to get the fullname. If a font is opened, return that name. - Otherwise, return nil. If ID is -1, or the fontset doesn't contain - information about C, get the registry and encoding of C from the - default fontset. Called from choose_face_font. */ + { + Lisp_Object elt, rfont_def, val; -Lisp_Object -fontset_font_pattern (f, id, c) - FRAME_PTR f; - int id, c; -{ - Lisp_Object fontset, elt; - struct font_info *fontp; + elt = FONTSET_REF (base_fontset, 0); + xassert (VECTORP (elt) && ASIZE (elt) > 0); + rfont_def = Fmake_vector (make_number (4), Qnil); +#ifdef USE_FONT_BACKEND + if (enable_font_backend && face->font_info) + { + struct font *font = (struct font *) face->font_info; - elt = Qnil; - if (fontset_id_valid_p (id)) - { - fontset = FONTSET_FROM_ID (id); - xassert (!BASE_FONTSET_P (fontset)); - fontset = FONTSET_BASE (fontset); - if (! EQ (fontset, Vdefault_fontset)) - elt = FONTSET_REF (fontset, c); - } - if (NILP (elt)) + ASET (rfont_def, 3, Fcons (font->entity, Qnil)); + } + else +#endif /* USE_FONT_BACKEND */ { - Lisp_Object frame; - - XSETFRAME (frame, f); - elt = lookup_overriding_fontspec (frame, c); + ASET (rfont_def, 3, build_string (face->font_name)); } - if (NILP (elt)) - elt = FONTSET_REF (Vdefault_fontset, c); - - if (!CONSP (elt)) - return Qnil; - if (CONSP (XCDR (elt))) - return XCDR (elt); - - /* The fontset specifies only a font name pattern (not cons of - family and registry). If a font can be opened by that pattern, - return the name of opened font. Otherwise return nil. The - exception is a font for single byte characters. In that case, we - return a cons of FAMILY and REGISTRY extracted from the opened - font name. */ - elt = XCDR (elt); - xassert (STRINGP (elt)); - fontp = FS_LOAD_FONT (f, c, SDATA (elt), -1); - if (!fontp) - return Qnil; - - return font_family_registry (build_string (fontp->full_name), - SINGLE_BYTE_CHAR_P (c)); + ASET (rfont_def, 1, make_number (face->font_info_id)); + ASET (rfont_def, 2, AREF (elt, 0)); + elt = Fmake_vector (make_number (4), Qnil); + ASET (elt, 0, make_number (charset_ordered_list_tick)); + ASET (elt, 1, make_number (charset_ascii)); + ASET (elt, 2, rfont_def); + ASET (elt, 3, rfont_def); + + val = Fcons (Qlatin, Qnil); + map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table, val); + for (val = XCDR (val); CONSP (val); val = XCDR (val)) + char_table_set_range (fontset, XINT (XCAR (XCAR (val))), + XINT (XCDR (XCAR (val))), elt); + FONTSET_FALLBACK (fontset) = elt; + } + return XINT (FONTSET_ID (fontset)); } @@ -638,125 +1147,57 @@ fontset_font_pattern (f, id, c) #pragma optimize("", off) #endif -/* Load a font named FONTNAME to display character C on frame F. - Return a pointer to the struct font_info of the loaded font. If - loading fails, return NULL. If FACE is non-zero and a fontset is - assigned to it, record FACE->id in the fontset for C. If FONTNAME - is NULL, the name is taken from the fontset of FACE or what - specified by ID. */ +/* Load a font named FONTNAME on frame F. Return a pointer to the + struct font_info of the loaded font. If loading fails, return + NULL. CHARSET is an ID of charset to encode characters for this + font. If it is -1, find one from Vfont_encoding_alist. */ struct font_info * -fs_load_font (f, c, fontname, id, face) +fs_load_font (f, fontname, charset) FRAME_PTR f; - int c; char *fontname; - int id; - struct face *face; + int charset; { - Lisp_Object fontset; - Lisp_Object list, elt, fullname; - int size = 0; struct font_info *fontp; - int charset = CHAR_CHARSET (c); - - if (face) - id = face->fontset; - if (id < 0) - fontset = Qnil; - else - fontset = FONTSET_FROM_ID (id); - - if (!NILP (fontset) - && !BASE_FONTSET_P (fontset)) - { - elt = FONTSET_REF_VIA_BASE (fontset, c); - if (!NILP (elt)) - { - /* A suitable face for C is already recorded, which means - that a proper font is already loaded. */ - int face_id = XINT (elt); - - xassert (face_id == face->id); - face = FACE_FROM_ID (f, face_id); - return (*get_font_info_func) (f, face->font_info_id); - } - - if (!fontname && charset == CHARSET_ASCII) - { - elt = FONTSET_ASCII (fontset); - fontname = SDATA (XCDR (elt)); - } - } + Lisp_Object fullname; if (!fontname) /* No way to get fontname. */ - return 0; + return NULL; - fontp = (*load_font_func) (f, fontname, size); - if (!fontp) - return 0; - - /* Fill in members (charset, vertical_centering, encoding, etc) of - font_info structure that are not set by (*load_font_func). */ - fontp->charset = charset; + fontp = (*load_font_func) (f, fontname, 0); + if (! fontp || fontp->charset >= 0) + return fontp; + fontname = fontp->full_name; fullname = build_string (fontp->full_name); - fontp->vertical_centering - = (STRINGP (Vvertical_centering_font_regexp) - && (fast_string_match_ignore_case - (Vvertical_centering_font_regexp, fullname) >= 0)); - if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED) + if (charset < 0) { - /* The font itself tells which code points to be used. Use this - encoding for all other charsets. */ - int i; - - fontp->encoding[0] = fontp->encoding[1]; - for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) - fontp->encoding[i] = fontp->encoding[1]; + Lisp_Object charset_symbol; + + charset_symbol = find_font_encoding (fullname); + if (CONSP (charset_symbol)) + charset_symbol = XCAR (charset_symbol); + if (NILP (charset_symbol)) + charset_symbol = Qascii; + charset = XINT (CHARSET_SYMBOL_ID (charset_symbol)); } - else - { - /* The font itself doesn't have information about encoding. */ - int i; + fontp->charset = charset; + fontp->vertical_centering = 0; + fontp->font_encoder = NULL; - /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F), - others is 1 (i.e. 0x80..0xFF). */ - fontp->encoding[0] = 0; - for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++) - fontp->encoding[i] = 1; - /* Then override them by a specification in Vfont_encoding_alist. */ - for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list)) - { - elt = XCAR (list); - if (CONSP (elt) - && STRINGP (XCAR (elt)) && CONSP (XCDR (elt)) - && (fast_string_match_ignore_case (XCAR (elt), fullname) >= 0)) - { - Lisp_Object tmp; + if (charset != charset_ascii) + { + fontp->vertical_centering + = (STRINGP (Vvertical_centering_font_regexp) + && (fast_string_match_ignore_case + (Vvertical_centering_font_regexp, fullname) >= 0)); - for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp)) - if (CONSP (XCAR (tmp)) - && ((i = get_charset_id (XCAR (XCAR (tmp)))) - >= 0) - && INTEGERP (XCDR (XCAR (tmp))) - && XFASTINT (XCDR (XCAR (tmp))) < 4) - fontp->encoding[i] - = XFASTINT (XCDR (XCAR (tmp))); - } - } + if (find_ccl_program_func) + (*find_ccl_program_func) (fontp); } - if (! fontp->font_encoder && find_ccl_program_func) - (*find_ccl_program_func) (fontp); - - /* If we loaded a font for a face that has fontset, record the face - ID in the fontset for C. */ - if (face - && !NILP (fontset) - && !BASE_FONTSET_P (fontset)) - FONTSET_SET (fontset, c, make_number (face->id)); return fontp; } @@ -764,24 +1205,34 @@ fs_load_font (f, c, fontname, id, face) #pragma optimize("", on) #endif -/* Set the ASCII font of the default fontset to FONTNAME if that is - not yet set. */ -void -set_default_ascii_font (fontname) + +/* Return ENCODING or a cons of ENCODING and REPERTORY of the font + FONTNAME. ENCODING is a charset symbol that specifies the encoding + of the font. REPERTORY is a charset symbol or nil. */ + + +Lisp_Object +find_font_encoding (fontname) Lisp_Object fontname; { - if (! CONSP (FONTSET_ASCII (Vdefault_fontset))) - { - int id = fs_query_fontset (fontname, 2); + Lisp_Object tail, elt; - if (id >= 0) - fontname = XCDR (FONTSET_ASCII (FONTSET_FROM_ID (id))); - FONTSET_ASCII (Vdefault_fontset) - = Fcons (make_number (0), fontname); + for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + if (CONSP (elt) + && STRINGP (XCAR (elt)) + && fast_string_match_ignore_case (XCAR (elt), fontname) >= 0 + && (SYMBOLP (XCDR (elt)) + ? CHARSETP (XCDR (elt)) + : CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt))))) + return (XCDR (elt)); } + /* We don't know the encoding of this font. Let's assume `ascii'. */ + return Qascii; } - + /* Cache data used by fontset_pattern_regexp. The car part is a pattern string containing at least one wild card, the cdr part is the corresponding regular expression. */ @@ -870,6 +1321,8 @@ fs_query_fontset (name, name_pattern) if (name_pattern != 1) { tem = Frassoc (name, Vfontset_alias_alist); + if (NILP (tem)) + tem = Fassoc (name, Vfontset_alias_alist); if (CONSP (tem) && STRINGP (XCAR (tem))) name = XCAR (tem); else if (name_pattern == 0) @@ -929,9 +1382,7 @@ If REGEXPP is non-nil, PATTERN is a regular expression. */) return FONTSET_NAME (fontset); } -/* Return a list of base fontset names matching PATTERN on frame F. - If SIZE is not 0, it is the size (maximum bound width) of fontsets - to be listed. */ +/* Return a list of base fontset names matching PATTERN on frame F. */ Lisp_Object list_fontsets (f, pattern, size) @@ -958,111 +1409,73 @@ list_fontsets (f, pattern, size) continue; name = FONTSET_NAME (fontset); - if (!NILP (regexp) + if (STRINGP (regexp) ? (fast_string_match (regexp, name) < 0) : strcmp (SDATA (pattern), SDATA (name))) continue; - if (size) - { - struct font_info *fontp; - fontp = FS_LOAD_FONT (f, 0, NULL, id); - if (!fontp || size != fontp->size) - continue; - } val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val); } return val; } -DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0, - doc: /* Create a new fontset NAME that contains font information in FONTLIST. -FONTLIST is an alist of charsets vs corresponding font name patterns. */) - (name, fontlist) - Lisp_Object name, fontlist; -{ - Lisp_Object fontset, elements, ascii_font; - Lisp_Object tem, tail, elt; - int id; - (*check_window_system_func) (); +/* Free all realized fontsets whose base fontset is BASE. */ - CHECK_STRING (name); - CHECK_LIST (fontlist); +static void +free_realized_fontsets (base) + Lisp_Object base; +{ + int id; - name = Fdowncase (name); - id = fs_query_fontset (name, 2); - if (id >= 0) +#if 0 + /* For the moment, this doesn't work because free_realized_face + doesn't remove FACE from a cache. Until we find a solution, we + suppress this code, and simply use Fclear_face_cache even though + that is not efficient. */ + BLOCK_INPUT; + for (id = 0; id < ASIZE (Vfontset_table); id++) { - fontset = FONTSET_FROM_ID (id); - tem = FONTSET_NAME (fontset); - error ("Fontset `%s' matches the existing fontset `%s'", - SDATA (name), SDATA (tem)); - } + Lisp_Object this = AREF (Vfontset_table, id); - /* Check the validity of FONTLIST while creating a template for - fontset elements. */ - elements = ascii_font = Qnil; - for (tail = fontlist; CONSP (tail); tail = XCDR (tail)) - { - int c, charset; + if (EQ (FONTSET_BASE (this), base)) + { + Lisp_Object tail; - tem = XCAR (tail); - if (!CONSP (tem) - || (charset = get_charset_id (XCAR (tem))) < 0 - || (!STRINGP (XCDR (tem)) && !CONSP (XCDR (tem)))) - error ("Elements of fontlist must be a cons of charset and font name pattern"); + for (tail = FONTSET_FACE_ALIST (this); CONSP (tail); + tail = XCDR (tail)) + { + FRAME_PTR f = XFRAME (FONTSET_FRAME (this)); + int face_id = XINT (XCDR (XCAR (tail))); + struct face *face = FACE_FROM_ID (f, face_id); - tem = XCDR (tem); - if (STRINGP (tem)) - tem = Fdowncase (tem); - else - tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem))); - if (charset == CHARSET_ASCII) - ascii_font = tem; - else - { - c = MAKE_CHAR (charset, 0, 0); - elements = Fcons (Fcons (make_number (c), tem), elements); + /* Face THIS itself is also freed by the following call. */ + free_realized_face (f, face); + } } } - - if (NILP (ascii_font)) - error ("No ASCII font in the fontlist"); - - fontset = make_fontset (Qnil, name, Qnil); - FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font); - for (; CONSP (elements); elements = XCDR (elements)) + UNBLOCK_INPUT; +#else /* not 0 */ + /* But, we don't have to call Fclear_face_cache if no fontset has + been realized from BASE. */ + for (id = 0; id < ASIZE (Vfontset_table); id++) { - elt = XCAR (elements); - tem = XCDR (elt); - if (STRINGP (tem)) - tem = font_family_registry (tem, 0); - tem = Fcons (XCAR (elt), tem); - FONTSET_SET (fontset, XINT (XCAR (elt)), tem); - } - - return Qnil; -} + Lisp_Object this = AREF (Vfontset_table, id); - -/* Clear all elements of FONTSET for multibyte characters. */ - -static void -clear_fontset_elements (fontset) - Lisp_Object fontset; -{ - int i; - - for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++) - XCHAR_TABLE (fontset)->contents[i] = Qnil; + if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base)) + { + Fclear_face_cache (Qt); + break; + } + } +#endif /* not 0 */ } /* Check validity of NAME as a fontset name and return the corresponding fontset. If not valid, signal an error. - If NAME is nil, return Vdefault_fontset. */ + If NAME is t, return Vdefault_fontset. */ static Lisp_Object check_fontset_name (name) @@ -1070,7 +1483,7 @@ check_fontset_name (name) { int id; - if (EQ (name, Qnil)) + if (EQ (name, Qt)) return Vdefault_fontset; CHECK_STRING (name); @@ -1084,125 +1497,485 @@ check_fontset_name (name) return FONTSET_FROM_ID (id); } -/* Downcase FONTNAME or car and cdr of FONTNAME. If FONTNAME is a - string, maybe change FONTNAME to (FAMILY . REGISTRY). */ +static void +accumulate_script_ranges (arg, range, val) + Lisp_Object arg, range, val; +{ + if (EQ (XCAR (arg), val)) + { + if (CONSP (range)) + XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg))); + else + XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg))); + } +} -static Lisp_Object -regularize_fontname (Lisp_Object fontname) + +/* Return an ASCII font name generated from fontset name NAME and + font-spec ASCII_SPEC. NAME is a string conforming to XLFD. */ + +static INLINE Lisp_Object +generate_ascii_font_name (name, ascii_spec) + Lisp_Object name, ascii_spec; +{ + Lisp_Object font_spec = Ffont_spec (0, NULL); + Lisp_Object vec; + int i; + char xlfd[256]; + + if (font_parse_xlfd (SDATA (name), font_spec) < 0) + error ("Not an XLFD font name: %s", SDATA (name)); + for (i = FONT_FOUNDRY_INDEX; i <= FONT_WIDTH_INDEX; i++) + if (! NILP (AREF (ascii_spec, i))) + ASET (font_spec, i, AREF (ascii_spec, i)); + i = font_unparse_xlfd (font_spec, 0, xlfd, 256); + if (i < 0) + error ("Not an XLFD font name: %s", SDATA (name)); + return make_unibyte_string (xlfd, i); +} + +/* Variables referred in set_fontset_font. They are set before + map_charset_chars is called in Fset_fontset_font. */ +static Lisp_Object font_def_arg, add_arg; +static int from_arg, to_arg; + +/* Callback function for map_charset_chars in Fset_fontset_font. In + FONTSET, set font_def_arg in a fashion specified by add_arg for + characters in RANGE while ignoring the range between from_arg and + to_arg. */ + +static void +set_fontset_font (fontset, range) + Lisp_Object fontset, range; +{ + if (from_arg < to_arg) + { + int from = XINT (XCAR (range)), to = XINT (XCDR (range)); + + if (from < from_arg) + { + if (to > to_arg) + { + Lisp_Object range2; + + range2 = Fcons (make_number (to_arg), XCDR (range)); + FONTSET_ADD (fontset, range, font_def_arg, add_arg); + to = to_arg; + } + if (to > from_arg) + range = Fcons (XCAR (range), make_number (from_arg)); + } + else if (to <= to_arg) + return; + else + { + if (from < to_arg) + range = Fcons (make_number (to_arg), XCDR (range)); + } + } + FONTSET_ADD (fontset, range, font_def_arg, add_arg); +} + +extern Lisp_Object QCfamily, QCregistry; + +DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0, + doc: /* +Modify fontset NAME to use FONT-SPEC for TARGET characters. + +TARGET may be a cons; (FROM . TO), where FROM and TO are characters. +In that case, use FONT-SPEC for all characters in the range FROM and +TO (inclusive). + +TARGET may be a script name symbol. In that case, use FONT-SPEC for +all characters that belong to the script. + +TARGET may be a charset. In that case, use FONT-SPEC for all +characters in the charset. + +TARGET may be nil. In that case, use FONT-SPEC for any characters for +that no FONT-SPEC is specified. + +FONT-SPEC may one of these: + * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and + REGISTRY is a font registry name. FAMILY may contains foundry + name, and REGISTRY may contains encoding name. + * A font name string. + +Optional 4th argument FRAME, if non-nil, is a frame. This argument is +kept for backward compatibility and has no meaning. + +Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC +to the font specifications for TARGET previously set. If it is +`prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is +appended. By default, FONT-SPEC overrides the previous settings. */) + (name, target, font_spec, frame, add) + Lisp_Object name, target, font_spec, frame, add; { - Lisp_Object family, registry; + Lisp_Object fontset; + Lisp_Object font_def, registry, family; + Lisp_Object encoding, repertory; + Lisp_Object range_list; + struct charset *charset = NULL; - if (STRINGP (fontname)) - return font_family_registry (Fdowncase (fontname), 0); + fontset = check_fontset_name (name); + + /* The arg FRAME is kept for backward compatibility. We only check + the validity. */ + if (!NILP (frame)) + CHECK_LIVE_FRAME (frame); - CHECK_CONS (fontname); - family = XCAR (fontname); - registry = XCDR (fontname); - if (!NILP (family)) + if (VECTORP (font_spec)) { - CHECK_STRING (family); - family = Fdowncase (family); + if (! FONT_SPEC_P (font_spec)) + Fsignal (Qfont, list2 (build_string ("invalid font-spec"), font_spec)); } - if (!NILP (registry)) + else if (CONSP (font_spec)) { + Lisp_Object args[4]; + int i= 0; + + family = XCAR (font_spec); + registry = XCDR (font_spec); + + if (! NILP (family)) + { + CHECK_STRING (family); + args[i++] = QCfamily; + args[i++] = family; + } CHECK_STRING (registry); - registry = Fdowncase (registry); + args[i++] = QCregistry; + args[i++] = registry; + font_spec = Ffont_spec (i, args); + } + else + { + Lisp_Object args[2]; + + CHECK_STRING (font_spec); + args[0] = QCname; + args[1] = font_spec; + font_spec = Ffont_spec (2, args); } - return Fcons (family, registry); + + family = AREF (font_spec, FONT_FAMILY_INDEX); + if (! NILP (family) && SYMBOLP (family)) + family = SYMBOL_NAME (family); + registry = AREF (font_spec, FONT_REGISTRY_INDEX); + if (! NILP (registry) && SYMBOLP (registry)) + registry = SYMBOL_NAME (registry); + + encoding = find_font_encoding (concat2 (family, registry)); + if (NILP (encoding)) + encoding = Qascii; + + if (SYMBOLP (encoding)) + { + CHECK_CHARSET (encoding); + encoding = repertory = CHARSET_SYMBOL_ID (encoding); + } + else + { + repertory = XCDR (encoding); + encoding = XCAR (encoding); + CHECK_CHARSET (encoding); + encoding = CHARSET_SYMBOL_ID (encoding); + if (! NILP (repertory) && SYMBOLP (repertory)) + { + CHECK_CHARSET (repertory); + repertory = CHARSET_SYMBOL_ID (repertory); + } + } + font_def = Fmake_vector (make_number (3), font_spec); + ASET (font_def, 1, encoding); + ASET (font_def, 2, repertory); + + if (CHARACTERP (target)) + range_list = Fcons (Fcons (target, target), Qnil); + else if (CONSP (target)) + { + Lisp_Object from, to; + + from = Fcar (target); + to = Fcdr (target); + CHECK_CHARACTER (from); + CHECK_CHARACTER (to); + range_list = Fcons (target, Qnil); + } + else if (SYMBOLP (target) && !NILP (target)) + { + Lisp_Object script_list; + Lisp_Object val; + + range_list = Qnil; + script_list = XCHAR_TABLE (Vchar_script_table)->extras[0]; + if (! NILP (Fmemq (target, script_list))) + { + val = Fcons (target, Qnil); + map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table, + val); + range_list = XCDR (val); + if (EQ (target, Qlatin)) + { + if (VECTORP (font_spec)) + val = generate_ascii_font_name (FONTSET_NAME (fontset), + font_spec); + else + val = font_spec; + FONTSET_ASCII (fontset) = val; + } + } + if (CHARSETP (target)) + { + if (EQ (target, Qascii)) + { + if (VECTORP (font_spec)) + font_spec = generate_ascii_font_name (FONTSET_NAME (fontset), + font_spec); + FONTSET_ASCII (fontset) = font_spec; + range_list = Fcons (Fcons (make_number (0), make_number (127)), + Qnil); + } + else + { + CHECK_CHARSET_GET_CHARSET (target, charset); + } + } + else if (NILP (range_list)) + error ("Invalid script or charset name: %s", + SDATA (SYMBOL_NAME (target))); + } + else if (NILP (target)) + range_list = Fcons (Qnil, Qnil); + else + error ("Invalid target for setting a font"); + + + if (charset) + { + font_def_arg = font_def; + add_arg = add; + if (NILP (range_list)) + from_arg = to_arg = 0; + else + from_arg = XINT (XCAR (XCAR (range_list))), + to_arg = XINT (XCDR (XCAR (range_list))); + + map_charset_chars (set_fontset_font, Qnil, fontset, charset, + CHARSET_MIN_CODE (charset), + CHARSET_MAX_CODE (charset)); + } + for (; CONSP (range_list); range_list = XCDR (range_list)) + FONTSET_ADD (fontset, XCAR (range_list), font_def, add); + + /* Free all realized fontsets whose base is FONTSET. This way, the + specified character(s) are surely redisplayed by a correct + font. */ + free_realized_fontsets (fontset); + + return Qnil; } -DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0, - doc: /* Modify fontset NAME to use FONTNAME for CHARACTER. -If NAME is nil, modify the default fontset. -CHARACTER may be a cons; (FROM . TO), where FROM and TO are -non-generic characters. In that case, use FONTNAME -for all characters in the range FROM and TO (inclusive). -CHARACTER may be a charset. In that case, use FONTNAME -for all character in the charsets. +DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0, + doc: /* Create a new fontset NAME from font information in FONTLIST. + +FONTLIST is an alist of scripts vs the corresponding font specification list. +Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a +character of SCRIPT is displayed by a font that matches one of +FONT-SPEC. + +SCRIPT is a symbol that appears in the first extra slot of the +char-table `char-script-table'. -FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family -name of a font, REGISTRY is a registry name of a font. */) - (name, character, fontname, frame) - Lisp_Object name, character, fontname, frame; +FONT-SPEC is a vector, a cons, or a string. See the documentation of +`set-fontset-font' for the meaning. */) + (name, fontlist) + Lisp_Object name, fontlist; { - Lisp_Object fontset, elt; - Lisp_Object realized; - int from, to; + Lisp_Object fontset; + Lisp_Object val; int id; - fontset = check_fontset_name (name); + CHECK_STRING (name); + CHECK_LIST (fontlist); + + id = fs_query_fontset (name, 0); + if (id < 0) + { + name = Fdowncase (name); + val = split_font_name_into_vector (name); + if (NILP (val) || NILP (AREF (val, 12)) || NILP (AREF (val, 13))) + error ("Fontset name must be in XLFD format"); + if (strcmp (SDATA (AREF (val, 12)), "fontset")) + error ("Registry field of fontset name must be \"fontset\""); + Vfontset_alias_alist + = Fcons (Fcons (name, + concat2 (concat2 (AREF (val, 12), build_string ("-")), + AREF (val, 13))), + Vfontset_alias_alist); + ASET (val, 12, build_string ("iso8859-1")); + fontset = make_fontset (Qnil, name, Qnil); + FONTSET_ASCII (fontset) = build_font_name_from_vector (val); + } + else + { + fontset = FONTSET_FROM_ID (id);; + free_realized_fontsets (fontset); + Fset_char_table_range (fontset, Qt, Qnil); + } - if (CONSP (character)) + for (; ! NILP (fontlist); fontlist = Fcdr (fontlist)) { - /* CH should be (FROM . TO) where FROM and TO are non-generic - characters. */ - CHECK_NUMBER_CAR (character); - CHECK_NUMBER_CDR (character); - from = XINT (XCAR (character)); - to = XINT (XCDR (character)); - if (!char_valid_p (from, 0) || !char_valid_p (to, 0)) - error ("Character range should be by non-generic characters"); - if (!NILP (name) - && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to))) - error ("Can't change font for a single byte character"); + Lisp_Object elt, script; + + elt = Fcar (fontlist); + script = Fcar (elt); + elt = Fcdr (elt); + if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt)))) + for (; CONSP (elt); elt = XCDR (elt)) + Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend); + else + Fset_fontset_font (name, script, elt, Qnil, Qappend); } - else if (SYMBOLP (character)) + return name; +} + + +/* Alist of automatically created fontsets. Each element is a cons + (FONTNAME . FONTSET-ID). */ +static Lisp_Object auto_fontset_alist; + +int +new_fontset_from_font_name (Lisp_Object fontname) +{ + Lisp_Object val; + Lisp_Object name; + Lisp_Object vec; + int id; + + fontname = Fdowncase (fontname); + val = Fassoc (fontname, auto_fontset_alist); + if (CONSP (val)) + return XINT (XCDR (val)); + + vec = split_font_name_into_vector (fontname); + if ( NILP (vec)) + vec = Fmake_vector (make_number (14), build_string ("")); + ASET (vec, 12, build_string ("fontset")); + if (NILP (auto_fontset_alist)) { - elt = Fget (character, Qcharset); - if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0))) - error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character))); - from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0); - to = from; + ASET (vec, 13, build_string ("startup")); + name = build_font_name_from_vector (vec); } else { - CHECK_NUMBER (character); - from = XINT (character); - to = from; + char temp[20]; + int len = XINT (Flength (auto_fontset_alist)); + + sprintf (temp, "auto%d", len); + ASET (vec, 13, build_string (temp)); + name = build_font_name_from_vector (vec); } - if (!char_valid_p (from, 1)) - invalid_character (from); - if (SINGLE_BYTE_CHAR_P (from)) - error ("Can't change font for a single byte character"); - if (from < to) + name = Fnew_fontset (name, list2 (list2 (Qascii, fontname), + list2 (Fcons (make_number (0), + make_number (MAX_CHAR)), + fontname))); + id = fs_query_fontset (name, 0); + auto_fontset_alist + = Fcons (Fcons (fontname, make_number (id)), auto_fontset_alist); + return id; +} + +#ifdef USE_FONT_BACKEND +int +new_fontset_from_font (font_object) + Lisp_Object font_object; +{ + Lisp_Object font_name = font_get_name (font_object); + Lisp_Object font_spec = font_get_spec (font_object); + Lisp_Object fontset_spec, short_name, name, fontset; + + if (NILP (auto_fontset_alist)) + short_name = build_string ("fontset-startup"); + else { - if (!char_valid_p (to, 1)) - invalid_character (to); - if (SINGLE_BYTE_CHAR_P (to)) - error ("Can't change font for a single byte character"); + char temp[32]; + int len = XINT (Flength (auto_fontset_alist)); + + sprintf (temp, "fontset-auto%d", len); + short_name = build_string (temp); } + fontset_spec = Fcopy_sequence (font_spec); + ASET (fontset_spec, FONT_REGISTRY_INDEX, short_name); + name = Ffont_xlfd_name (fontset_spec); + if (NILP (name)) + { + int i; - /* The arg FRAME is kept for backward compatibility. We only check - the validity. */ - if (!NILP (frame)) - CHECK_LIVE_FRAME (frame); + for (i = 0; i < FONT_SIZE_INDEX; i++) + if ((i != FONT_FAMILY_INDEX) && (i != FONT_REGISTRY_INDEX)) + ASET (fontset_spec, i, Qnil); + name = Ffont_xlfd_name (fontset_spec); + if (NILP (name)) + abort (); + } + fontset = make_fontset (Qnil, name, Qnil); + FONTSET_ASCII (fontset) = font_name; + font_spec = Fcons (SYMBOL_NAME (AREF (font_spec, FONT_FAMILY_INDEX)), + SYMBOL_NAME (AREF (font_spec, FONT_REGISTRY_INDEX))); + Fset_fontset_font (name, Qlatin, font_spec, Qnil, Qnil); + Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil); + return XINT (FONTSET_ID (fontset)); +} - elt = Fcons (make_number (from), regularize_fontname (fontname)); - for (; from <= to; from++) - FONTSET_SET (fontset, from, elt); - Foptimize_char_table (fontset); +struct font * +fontset_ascii_font (f, id) + FRAME_PTR f; + int id; +{ + Lisp_Object fontset = FONTSET_FROM_ID (id); + Lisp_Object ascii_slot = FONTSET_ASCII (fontset); + Lisp_Object val, font_object; - /* If there's a realized fontset REALIZED whose parent is FONTSET, - clear all the elements of REALIZED and free all multibyte faces - whose fontset is REALIZED. This way, the specified character(s) - are surely redisplayed by a correct font. */ - for (id = 0; id < ASIZE (Vfontset_table); id++) + if (CONSP (ascii_slot)) { - realized = AREF (Vfontset_table, id); - if (!NILP (realized) - && !BASE_FONTSET_P (realized) - && EQ (FONTSET_BASE (realized), fontset)) + Lisp_Object ascii_font_name = XCAR (ascii_slot); + + font_object = Qnil; + for (val = XCDR (ascii_slot); ! NILP (val); val = XCDR (val)) { - FRAME_PTR f = XFRAME (FONTSET_FRAME (realized)); - clear_fontset_elements (realized); - free_realized_multibyte_face (f, id); + Lisp_Object frame = font_get_frame (XCAR (val)); + + if (NILP (frame) || XFRAME (frame) == f) + { + font_object = XCAR (val); + if (XSAVE_VALUE (font_object)->integer == 0) + { + font_object = font_open_by_name (f, SDATA (ascii_font_name)); + XSETCAR (val, font_object); + } + break; + } + } + if (NILP (font_object)) + { + font_object = font_open_by_name (f, SDATA (ascii_font_name)); + XSETCDR (ascii_slot, Fcons (font_object, XCDR (ascii_slot))); } } - - return Qnil; + else + { + font_object = font_open_by_name (f, SDATA (ascii_slot)); + FONTSET_ASCII (fontset) = Fcons (ascii_slot, Fcons (font_object, Qnil)); + } + if (NILP (font_object)) + return NULL; + return XSAVE_VALUE (font_object)->pointer; } +#endif /* USE_FONT_BACKEND */ + DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0, doc: /* Return information about a font named NAME on frame FRAME. If FRAME is omitted or nil, use the selected frame. @@ -1223,6 +1996,7 @@ If the named font is not yet loaded, return nil. */) FRAME_PTR f; struct font_info *fontp; Lisp_Object info; + Lisp_Object font_object; (*check_window_system_func) (); @@ -1236,6 +2010,17 @@ If the named font is not yet loaded, return nil. */) if (!query_font_func) error ("Font query function is not supported"); +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + font_object = font_open_by_name (f, SDATA (name)); + if (NILP (font_object)) + fontp = NULL; + else + fontp = (struct font_info *) XSAVE_VALUE (font_object)->pointer; + } + else +#endif /* USE_FONT_BACKEND */ fontp = (*query_font_func) (f, SDATA (name)); if (!fontp) return Qnil; @@ -1250,6 +2035,10 @@ If the named font is not yet loaded, return nil. */) XVECTOR (info)->contents[5] = make_number (fontp->relative_compose); XVECTOR (info)->contents[6] = make_number (fontp->default_ascent); +#ifdef USE_FONT_BACKEND + if (! NILP (font_object)) + font_close_object (f, font_object); +#endif /* USE_FONT_BACKEND */ return info; } @@ -1288,20 +2077,24 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, { int pos, pos_byte, dummy; int face_id; - int c, code; + int c; struct frame *f; struct face *face; + Lisp_Object charset, rfont_def; + int cs_id; if (NILP (position)) { - CHECK_NATNUM (ch); + CHECK_CHARACTER (ch); c = XINT (ch); f = XFRAME (selected_frame); face_id = DEFAULT_FACE_ID; + pos = -1; + cs_id = -1; } else { - Lisp_Object window; + Lisp_Object window, charset; struct window *w; CHECK_NUMBER_COERCE_MARKER (position); @@ -1322,231 +2115,254 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, w = XWINDOW (window); f = XFRAME (w->frame); face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0); + charset = Fget_char_property (position, Qcharset, Qnil); + if (CHARSETP (charset)) + cs_id = XINT (CHARSET_SYMBOL_ID (charset)); + else + cs_id = -1; } if (! CHAR_VALID_P (c, 0)) return Qnil; - face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c); + face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil); face = FACE_FROM_ID (f, face_id); - if (! face->font || ! face->font_name) - return Qnil; - - { - struct font_info *fontp = (*get_font_info_func) (f, face->font_info_id); - XChar2b char2b; - int c1, c2, charset; - - SPLIT_CHAR (c, charset, c1, c2); - if (c2 > 0) - STORE_XCHAR2B (&char2b, c1, c2); - else - STORE_XCHAR2B (&char2b, 0, c1); - FRAME_RIF (f)->encode_char (c, &char2b, fontp, NULL); - code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b); - } - return Fcons (build_string (face->font_name), make_number (code)); + rfont_def = fontset_font (FONTSET_FROM_ID (face->fontset), c, face, cs_id); +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + if (VECTORP (rfont_def) && ! NILP (AREF (rfont_def, 3))) + { + Lisp_Object font_object = XCAR (AREF (rfont_def, 3)); + struct font *font = XSAVE_VALUE (font_object)->pointer; + unsigned code = font->driver->encode_char (font, c); + Lisp_Object fontname = font_get_name (font_object); + + if (code == FONT_INVALID_CODE) + return Fcons (fontname, Qnil); + if (code <= MOST_POSITIVE_FIXNUM) + return Fcons (fontname, make_number (code)); + return Fcons (fontname, Fcons (make_number (code >> 16), + make_number (code & 0xFFFF))); + } + return Qnil; + } +#endif /* USE_FONT_BACKEND */ + if (VECTORP (rfont_def) && STRINGP (AREF (rfont_def, 3))) + { + Lisp_Object font_def; + struct font_info *fontp; + struct charset *charset; + XChar2b char2b; + int code; + + font_def = AREF (rfont_def, 2); + charset = CHARSET_FROM_ID (XINT (AREF (font_def, 1))); + code = ENCODE_CHAR (charset, c); + if (code == CHARSET_INVALID_CODE (charset)) + return (Fcons (AREF (rfont_def, 3), Qnil)); + STORE_XCHAR2B (&char2b, ((code >> 8) & 0xFF), (code & 0xFF)); + fontp = (*get_font_info_func) (f, XINT (AREF (rfont_def, 1))); + FRAME_RIF (f)->encode_char (c, &char2b, fontp, charset, NULL); + code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b); + return (Fcons (AREF (rfont_def, 3), make_number (code))); + } + return Qnil; } -/* Called from Ffontset_info via map_char_table on each leaf of - fontset. ARG is a copy of the default fontset. The current leaf - is indexed by CHARACTER and has value ELT. This function override - the copy by ELT if ELT is not nil. */ - -static void -override_font_info (fontset, character, elt) - Lisp_Object fontset, character, elt; -{ - if (! NILP (elt)) - Faset (fontset, character, elt); -} +DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0, + doc: /* Return information about a fontset FONTSET on frame FRAME. +The value is a char-table of which elements has this form. -/* Called from Ffontset_info via map_char_table on each leaf of - fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last - ARG)' and FONT-INFOs have this form: - (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC) - The current leaf is indexed by CHARACTER and has value ELT. This - function add the information of the current leaf to ARG by - appending a new element or modifying the last element. */ + ((FONT-PATTERN OPENED-FONT ...) ...) -static void -accumulate_font_info (arg, character, elt) - Lisp_Object arg, character, elt; -{ - Lisp_Object last, last_char, last_elt; +FONT-PATTERN is a vector: - if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character))) - elt = FONTSET_REF (Vdefault_fontset, XINT (character)); - if (!CONSP (elt)) - return; - last = XCAR (arg); - last_char = XCAR (XCAR (last)); - last_elt = XCAR (XCDR (XCAR (last))); - elt = XCDR (elt); - if (!NILP (Fequal (elt, last_elt))) - { - int this_charset = CHAR_CHARSET (XINT (character)); + [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ] - if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */ - { - if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char)))) - { - XSETCDR (last_char, character); - return; - } - } - else if (XINT (last_char) == XINT (character)) - return; - else if (this_charset == CHAR_CHARSET (XINT (last_char))) - { - XSETCAR (XCAR (last), Fcons (last_char, character)); - return; - } - } - XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil)); - XSETCAR (arg, XCDR (last)); -} +or a string of font name pattern. +OPENED-FONT is a name of a font actually opened. -DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0, - doc: /* Return information about a fontset named NAME on frame FRAME. -If NAME is nil, return information about the default fontset. -The value is a vector: - [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ], -where, - SIZE is the maximum bound width of ASCII font in the fontset, - HEIGHT is the maximum bound height of ASCII font in the fontset, - CHARSET-OR-RANGE is a charset, a character (may be a generic character) - or a cons of two characters specifying the range of characters. - FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY), - where FAMILY is a `FAMILY' field of a XLFD font name, - REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name. - FAMILY may contain a `FOUNDRY' field at the head. - REGISTRY may contain a `CHARSET_ENCODING' field at the tail. - OPENEDs are names of fonts actually opened. -If the ASCII font is not yet opened, SIZE and HEIGHT are 0. -If FRAME is omitted, it defaults to the currently selected frame. */) - (name, frame) - Lisp_Object name, frame; +The char-table has one extra slot. The value is a char-table +containing the information about the derived fonts from the default +fontset. The format is the same as abobe. */) + (fontset, frame) + Lisp_Object fontset, frame; { - Lisp_Object fontset; FRAME_PTR f; - int indices[3]; - Lisp_Object val, tail, elt; - Lisp_Object *realized; - struct font_info *fontp = NULL; - int n_realized = 0; - int i; + Lisp_Object *realized[2], fontsets[2], tables[2]; + Lisp_Object val, elt; + int c, i, j, k; (*check_window_system_func) (); - fontset = check_fontset_name (name); + fontset = check_fontset_name (fontset); if (NILP (frame)) frame = selected_frame; CHECK_LIVE_FRAME (frame); f = XFRAME (frame); - /* Recode realized fontsets whose base is FONTSET in the table - `realized'. */ - realized = (Lisp_Object *) alloca (sizeof (Lisp_Object) - * ASIZE (Vfontset_table)); - for (i = 0; i < ASIZE (Vfontset_table); i++) + /* Recode fontsets realized on FRAME from the base fontset FONTSET + in the table `realized'. */ + realized[0] = (Lisp_Object *) alloca (sizeof (Lisp_Object) + * ASIZE (Vfontset_table)); + for (i = j = 0; i < ASIZE (Vfontset_table); i++) { elt = FONTSET_FROM_ID (i); if (!NILP (elt) - && EQ (FONTSET_BASE (elt), fontset)) - realized[n_realized++] = elt; + && EQ (FONTSET_BASE (elt), fontset) + && EQ (FONTSET_FRAME (elt), frame)) + realized[0][j++] = elt; } + realized[0][j] = Qnil; - if (! EQ (fontset, Vdefault_fontset)) + realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object) + * ASIZE (Vfontset_table)); + for (i = j = 0; ! NILP (realized[0][i]); i++) { - /* Merge FONTSET onto the default fontset. */ - val = Fcopy_sequence (Vdefault_fontset); - map_char_table (override_font_info, Qnil, fontset, fontset, val, 0, indices); - fontset = val; + elt = FONTSET_DEFAULT (realized[0][i]); + if (! NILP (elt)) + realized[1][j++] = elt; } + realized[1][j] = Qnil; + + tables[0] = Fmake_char_table (Qfontset_info, Qnil); + tables[1] = Fmake_char_table (Qnil, Qnil); + XCHAR_TABLE (tables[0])->extras[0] = tables[1]; + fontsets[0] = fontset; + fontsets[1] = Vdefault_fontset; - /* Accumulate information of the fontset in VAL. The format is - (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE - FONT-SPEC). See the comment for accumulate_font_info for the - detail. */ - val = Fcons (Fcons (make_number (0), - Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)), - Qnil); - val = Fcons (val, val); - map_char_table (accumulate_font_info, Qnil, fontset, fontset, val, 0, indices); - val = XCDR (val); - - /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic - character for a charset, replace it with the charset symbol. If - fonts are opened for FONT-SPEC, append the names of the fonts to - FONT-SPEC. */ - for (tail = val; CONSP (tail); tail = XCDR (tail)) + /* Accumulate information of the fontset in TABLE. The format of + each element is ((FONT-SPEC OPENED-FONT ...) ...). */ + for (k = 0; k <= 1; k++) { - int c; - elt = XCAR (tail); - if (INTEGERP (XCAR (elt))) + for (c = 0; c <= MAX_CHAR; ) { - int charset, c1, c2; - c = XINT (XCAR (elt)); - SPLIT_CHAR (c, charset, c1, c2); - if (c1 == 0) - XSETCAR (elt, CHARSET_SYMBOL (charset)); - } - else - c = XINT (XCAR (XCAR (elt))); - for (i = 0; i < n_realized; i++) - { - Lisp_Object face_id, font; - struct face *face; + int from, to; - face_id = FONTSET_REF_VIA_BASE (realized[i], c); - if (INTEGERP (face_id)) + if (c <= MAX_5_BYTE_CHAR) + { + val = char_table_ref_and_range (fontsets[k], c, &from, &to); + if (to > MAX_5_BYTE_CHAR) + to = MAX_5_BYTE_CHAR; + } + else { - face = FACE_FROM_ID (f, XINT (face_id)); - if (face && face->font && face->font_name) + val = FONTSET_FALLBACK (fontsets[k]); + to = MAX_CHAR; + } + if (VECTORP (val)) + { + Lisp_Object alist; + + /* At first, set ALIST to ((FONT-SPEC) ...). */ + for (alist = Qnil, i = 0; i < ASIZE (val); i++) + alist = Fcons (Fcons (AREF (AREF (val, i), 0), Qnil), alist); + alist = Fnreverse (alist); + + /* Then store opend font names to cdr of each elements. */ + for (i = 0; ! NILP (realized[k][i]); i++) { - font = build_string (face->font_name); - if (NILP (Fmember (font, XCDR (XCDR (elt))))) - XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt)))); + if (c <= MAX_5_BYTE_CHAR) + val = FONTSET_REF (realized[k][i], c); + else + val = FONTSET_FALLBACK (realized[k][i]); + if (! VECTORP (val)) + continue; + /* VAL is [int int ? + [FACE-ID FONT-INDEX FONT-DEF FONT-NAME] ...]. + If a font of an element is already opened, + FONT-NAME is the name of a opened font. */ + for (j = 3; j < ASIZE (val); j++) + if (STRINGP (AREF (AREF (val, j), 3))) + { + Lisp_Object font_idx; + + font_idx = AREF (AREF (val, j), 1); + elt = Fassq (AREF (AREF (AREF (val, j), 2), 0), alist); + if (CONSP (elt) + && NILP (Fmemq (font_idx, XCDR(elt)))) + nconc2 (elt, Fcons (font_idx, Qnil)); + } } + for (val = alist; CONSP (val); val = XCDR (val)) + for (elt = XCDR (XCAR (val)); CONSP (elt); elt = XCDR (elt)) + { + struct font_info *font_info + = (*get_font_info_func) (f, XINT (XCAR (elt))); + XSETCAR (elt, build_string (font_info->full_name)); + } + + /* Store ALIST in TBL for characters C..TO. */ + if (c <= MAX_5_BYTE_CHAR) + char_table_set_range (tables[k], c, to, alist); + else + XCHAR_TABLE (tables[k])->defalt = alist; } + c = to + 1; } } - elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val))); - if (CONSP (elt)) - { - elt = XCAR (elt); - fontp = (*query_font_func) (f, SDATA (elt)); - } - val = Fmake_vector (make_number (3), val); - AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0); - AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0); - return val; + return tables[0]; } -DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0, + +DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0, doc: /* Return a font name pattern for character CH in fontset NAME. -If NAME is nil, find a font name pattern in the default fontset. */) - (name, ch) - Lisp_Object name, ch; +If NAME is t, find a pattern in the default fontset. + +The value has the form (FAMILY . REGISTRY), where FAMILY is a font +family name and REGISTRY is a font registry name. This is actually +the first font name pattern for CH in the fontset or in the default +fontset. + +If the 2nd optional arg ALL is non-nil, return a list of all font name +patterns. */) + (name, ch, all) + Lisp_Object name, ch, all; { int c; - Lisp_Object fontset, elt; + Lisp_Object fontset, elt, list, repertory, val; + int i, j; fontset = check_fontset_name (name); - CHECK_NUMBER (ch); + CHECK_CHARACTER (ch); c = XINT (ch); - if (!char_valid_p (c, 1)) - invalid_character (c); - - elt = FONTSET_REF (fontset, c); - if (CONSP (elt)) - elt = XCDR (elt); + list = Qnil; + while (1) + { + for (i = 0, elt = FONTSET_REF (fontset, c); i < 2; + i++, elt = FONTSET_FALLBACK (fontset)) + if (VECTORP (elt)) + for (j = 0; j < ASIZE (elt); j++) + { + val = AREF (elt, j); + repertory = AREF (val, 1); + if (INTEGERP (repertory)) + { + struct charset *charset = CHARSET_FROM_ID (XINT (repertory)); - return elt; + if (! CHAR_CHARSET_P (c, charset)) + continue; + } + else if (CHAR_TABLE_P (repertory)) + { + if (NILP (CHAR_TABLE_REF (repertory, c))) + continue; + } + val = AREF (val, 0); + val = Fcons (AREF (val, 0), AREF (val, 5)); + if (NILP (all)) + return val; + list = Fcons (val, list); + } + if (EQ (fontset, Vdefault_fontset)) + break; + fontset = Vdefault_fontset; + } + return (Fnreverse (list)); } DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0, @@ -1568,62 +2384,58 @@ DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0, return list; } -DEFUN ("set-overriding-fontspec-internal", Fset_overriding_fontspec_internal, - Sset_overriding_fontspec_internal, 1, 1, 0, - doc: /* Internal use only. - -FONTLIST is an alist of TARGET vs FONTNAME, where TARGET is a charset -or a char-table, FONTNAME have the same meanings as in -`set-fontset-font'. - -It overrides the font specifications for each TARGET in the default -fontset by the corresponding FONTNAME. -If TARGET is a charset, targets are all characters in the charset. If -TARGET is a char-table, targets are characters whose value is non-nil -in the table. +#ifdef FONTSET_DEBUG -It is intended that this function is called only from -`set-language-environment'. */) - (fontlist) - Lisp_Object fontlist; +Lisp_Object +dump_fontset (fontset) + Lisp_Object fontset; { - Lisp_Object tail; + Lisp_Object vec; + + vec = Fmake_vector (make_number (3), Qnil); + ASET (vec, 0, FONTSET_ID (fontset)); - fontlist = Fcopy_sequence (fontlist); - /* Now FONTLIST is ((TARGET . FONTNAME) ...). Reform it to ((TARGET - nil nil nil FONTSPEC) ...), where TARGET is a charset-id or a - char-table. */ - for (tail = fontlist; CONSP (tail); tail = XCDR (tail)) + if (BASE_FONTSET_P (fontset)) + { + ASET (vec, 1, FONTSET_NAME (fontset)); + } + else { - Lisp_Object elt, target; + Lisp_Object frame; - elt = XCAR (tail); - target = Fcar (elt); - elt = Fcons (Qnil, regularize_fontname (Fcdr (elt))); - if (! CHAR_TABLE_P (target)) + frame = FONTSET_FRAME (fontset); + if (FRAMEP (frame)) { - int charset, c; - - CHECK_SYMBOL (target); - charset = get_charset_id (target); - if (charset < 0) - error ("Invalid charset %s", SDATA (SYMBOL_NAME (target))); - target = make_number (charset); - c = MAKE_CHAR (charset, 0, 0); - XSETCAR (elt, make_number (c)); + FRAME_PTR f = XFRAME (frame); + + if (FRAME_LIVE_P (f)) + ASET (vec, 1, + Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name)); + else + ASET (vec, 1, + Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil)); } - elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt))); - XSETCAR (tail, elt); + if (!NILP (FONTSET_DEFAULT (fontset))) + ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset))); } - if (! NILP (Fequal (fontlist, Voverriding_fontspec_alist))) - return Qnil; - Voverriding_fontspec_alist = fontlist; - clear_face_cache (0); - ++windows_or_buffers_changed; - return Qnil; + return vec; } +DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0, + doc: /* Return a brief summary of all fontsets for debug use. */) + () +{ + Lisp_Object val; + int i; + + for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++) + if (! NILP (AREF (Vfontset_table, i))) + val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val); + return (Fnreverse (val)); +} +#endif /* FONTSET_DEBUG */ + void syms_of_fontset () { @@ -1631,9 +2443,14 @@ syms_of_fontset () /* Window system initializer should have set proper functions. */ abort (); - Qfontset = intern ("fontset"); - staticpro (&Qfontset); - Fput (Qfontset, Qchar_table_extra_slots, make_number (3)); + DEFSYM (Qfontset, "fontset"); + Fput (Qfontset, Qchar_table_extra_slots, make_number (9)); + DEFSYM (Qfontset_info, "fontset-info"); + Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1)); + + DEFSYM (Qprepend, "prepend"); + DEFSYM (Qappend, "append"); + DEFSYM (Qlatin, "latin"); Vcached_fontset_data = Qnil; staticpro (&Vcached_fontset_data); @@ -1649,32 +2466,45 @@ syms_of_fontset () AREF (Vfontset_table, 0) = Vdefault_fontset; next_fontset_id = 1; - Voverriding_fontspec_alist = Qnil; - staticpro (&Voverriding_fontspec_alist); + auto_fontset_alist = Qnil; + staticpro (&auto_fontset_alist); DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist, - doc: /* Alist of fontname patterns vs corresponding encoding info. -Each element looks like (REGEXP . ENCODING-INFO), - where ENCODING-INFO is an alist of CHARSET vs ENCODING. -ENCODING is one of the following integer values: - 0: code points 0x20..0x7F or 0x2020..0x7F7F are used, - 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used, - 2: code points 0x20A0..0x7FFF are used, - 3: code points 0xA020..0xFF7F are used. */); + doc: /* +Alist of fontname patterns vs the corresponding encoding and repertory info. +Each element looks like (REGEXP . (ENCODING . REPERTORY)), +where ENCODING is a charset or a char-table, +and REPERTORY is a charset, a char-table, or nil. + +If ENCDING and REPERTORY are the same, the element can have the form +\(REGEXP . ENCODING). + +ENCODING is for converting a character to a glyph code of the font. +If ENCODING is a charset, encoding a character by the charset gives +the corresponding glyph code. If ENCODING is a char-table, looking up +the table by a character gives the corresponding glyph code. + +REPERTORY specifies a repertory of characters supported by the font. +If REPERTORY is a charset, all characters beloging to the charset are +supported. If REPERTORY is a char-table, all characters who have a +non-nil value in the table are supported. It REPERTORY is nil, Emacs +gets the repertory information by an opened font and ENCODING. */); Vfont_encoding_alist = Qnil; - Vfont_encoding_alist - = Fcons (Fcons (build_string ("JISX0201"), - Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)), - Qnil)), - Vfont_encoding_alist); - Vfont_encoding_alist - = Fcons (Fcons (build_string ("ISO8859-1"), - Fcons (Fcons (intern ("ascii"), make_number (0)), - Qnil)), - Vfont_encoding_alist); + + DEFVAR_LISP ("font-encoding-charset-alist", &Vfont_encoding_charset_alist, + doc: /* +Alist of charsets vs the charsets to determine the preferred font encoding. +Each element looks like (CHARSET . ENCDOING-CHARSET), +where ENCODING-CHARSET is a charset registered in the variable +`font-encoding-alist' as ENCODING. + +When a text has a property `charset' and the value is CHARSET, a font +whose encoding corresponds to ENCODING-CHARSET is preferred. */); + Vfont_encoding_charset_alist = Qnil; DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent, - doc: /* Char table of characters whose ascent values should be ignored. + doc: /* +Char table of characters whose ascent values should be ignored. If an entry for a character is non-nil, the ascent value of the glyph is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font. @@ -1683,7 +2513,8 @@ such a character is displayed on screen. */); Vuse_default_ascent = Qnil; DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition, - doc: /* Char table of characters which is not composed relatively. + doc: /* +Char table of characters which is not composed relatively. If an entry for a character is non-nil, a composition sequence which contains that character is displayed so that the glyph of that character is put without considering @@ -1709,6 +2540,10 @@ When a character is displayed with such fonts, the character is displayed at the vertical center of lines. */); Vvertical_centering_font_regexp = Qnil; + DEFVAR_LISP ("otf-script-alist", &Votf_script_alist, + doc: /* Alist of OpenType script tags vs the corresponding script names. */); + Votf_script_alist = Qnil; + defsubr (&Squery_fontset); defsubr (&Snew_fontset); defsubr (&Sset_fontset_font); @@ -1717,7 +2552,9 @@ at the vertical center of lines. */); defsubr (&Sfontset_info); defsubr (&Sfontset_font); defsubr (&Sfontset_list); - defsubr (&Sset_overriding_fontspec_internal); +#ifdef FONTSET_DEBUG + defsubr (&Sfontset_list_all); +#endif } /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537 diff --git a/src/fontset.h b/src/fontset.h index c8bd1e36eab..353f01b27b0 100644 --- a/src/fontset.h +++ b/src/fontset.h @@ -5,6 +5,9 @@ 2005, 2006, 2007 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 + Copyright (C) 2003, 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 This file is part of GNU Emacs. @@ -44,7 +47,8 @@ struct font_info /* Full name of the font given by a window system. */ char *full_name; - /* Charset of characters displayed by the font. */ + /* Charset to encode a character code into a glyph code of the + font. */ int charset; #ifdef WINDOWSNT @@ -71,25 +75,15 @@ struct font_info of lines. */ int vertical_centering; - /* Encodings of the font indexed by CHARSET. The value is one of + /* Encoding type of the font. The value is one of 0, 1, 2, or 3: 0: code points 0x20..0x7F or 0x2020..0x7F7F are used 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used 2: code points 0x20A0..0x7FFF are used 3: code points 0xA020..0xFF7F are used - For instance, ASCII and Latin-1 characters may use the same font - but different code points (ASCII uses 0x20..0x7F and Latin-1 uses - 0xA0..0xFF). - - If the value can't be decided from information of the font, we - consult `font-encoding-alist' to get of the corresponding charset - whose default value is defined in lisp/fontset.el. Since there's - no charset whose id is 1, we use encoding[1] to store the - encoding information decided by the font itself. - If the member `font_encoder' is not NULL, this member is ignored. */ - unsigned char encoding[MAX_CHARSET + 1]; + unsigned char encoding_type; /* The baseline position of a font is normally `ascent' value of the font. However, there exists many fonts which don't set `ascent' @@ -149,6 +143,17 @@ struct font_info to be used. */ #define FONT_ENCODING_NOT_DECIDED 255 +enum FONT_SPEC_INDEX + { + FONT_SPEC_FAMILY_INDEX, + FONT_SPEC_WEIGHT_INDEX, + FONT_SPEC_SLANT_INDEX, + FONT_SPEC_SWIDTH_INDEX, + FONT_SPEC_ADSTYLE_INDEX, + FONT_SPEC_REGISTRY_INDEX, + FONT_SPEC_MAX_INDEX + }; + /* Forward declaration for prototypes. */ struct frame; @@ -188,43 +193,41 @@ extern void (*set_frame_fontset_func) P_ ((struct frame *f, Lisp_Object arg, This function set the memer `encoder' of the structure. */ extern void (*find_ccl_program_func) P_ ((struct font_info *)); +extern Lisp_Object (*get_font_repertory_func) P_ ((struct frame *, + struct font_info *)); + /* Check if any window system is used now. */ extern void (*check_window_system_func) P_ ((void)); struct face; extern void free_face_fontset P_ ((FRAME_PTR, struct face *)); -extern Lisp_Object fontset_font_pattern P_ ((FRAME_PTR, int, int)); +extern Lisp_Object fontset_font_pattern P_ ((FRAME_PTR, struct face *, int)); extern int face_suitable_for_char_p P_ ((struct face *, int)); -extern int face_for_char P_ ((FRAME_PTR, struct face *, int)); -extern int make_fontset_for_ascii_face P_ ((FRAME_PTR, int)); +extern int face_for_char P_ ((FRAME_PTR, struct face *, int, + int, Lisp_Object)); +extern int make_fontset_for_ascii_face P_ ((FRAME_PTR, int, struct face *)); +extern int new_fontset_from_font_name P_ ((Lisp_Object)); extern void set_default_ascii_font P_ ((Lisp_Object)); -extern struct font_info *fs_load_font P_ ((struct frame *, int, char *, int, - struct face *)); +extern struct font_info *fs_load_font P_ ((struct frame *, char *, int)); extern int fs_query_fontset P_ ((Lisp_Object, int)); EXFUN (Fquery_fontset, 2); extern Lisp_Object list_fontsets P_ ((struct frame *, Lisp_Object, int)); -extern Lisp_Object Qfontset; extern Lisp_Object Vuse_default_ascent; extern Lisp_Object Vignore_relative_composition; extern Lisp_Object Valternate_fontname_alist; extern Lisp_Object Vfontset_alias_alist; extern Lisp_Object Vvertical_centering_font_regexp; +extern Lisp_Object Votf_script_alist; -/* Load a font named FONTNAME for displaying character C. All fonts - for frame F is stored in a table pointed by FONT_TABLE. Return a - pointer to the struct font_info of the loaded font. If loading - fails, return 0; If FONTNAME is NULL, the name is taken from the - information of FONTSET. If FONTSET is given, try to load a font - whose size matches that of FONTSET, and, the font index is stored - in the table for FONTSET. */ +/* Load a font named FONTNAME on frame F. All fonts for frame F is + stored in a table pointed by FONT_TABLE. Return a pointer to the + struct font_info of the loaded font. If loading fails, return + NULL. */ -#define FS_LOAD_FONT(f, c, fontname, fontset) \ - fs_load_font (f, c, fontname, fontset, NULL) +#define FS_LOAD_FONT(f, fontname) fs_load_font (f, fontname, -1) -#define FS_LOAD_FACE_FONT(f, c, fontname, face) \ - fs_load_font (f, c, fontname, -1, face) /* Return an immutable id for font_info FONT_INFO on frame F. The reason for this macro is hat one cannot hold pointers to font_info @@ -242,10 +245,26 @@ extern Lisp_Object Vvertical_centering_font_regexp; ? (FRAME_X_DISPLAY_INFO ((F))->font_table + (ID)) \ : 0) +#ifdef USE_FONT_BACKEND +#define FONT_INFO_FROM_FACE(F, FACE) \ + (enable_font_backend ? (FACE)->font_info \ + : FONT_INFO_FROM_ID ((F), (FACE)->font_info_id)) +#else /* not USE_FONT_BACKEND */ +#define FONT_INFO_FROM_FACE(F, FACE) \ + FONT_INFO_FROM_ID ((F), (FACE)->font_info_id) +#endif /* not USE_FONT_BACKEND */ + extern Lisp_Object fontset_name P_ ((int)); extern Lisp_Object fontset_ascii P_ ((int)); extern int fontset_height P_ ((int)); +#ifdef USE_FONT_BACKEND +struct font; +extern int face_for_font P_ ((struct frame *, struct font *, struct face *)); +extern int new_fontset_from_font P_ ((Lisp_Object)); +extern struct font *fontset_ascii_font P_ ((FRAME_PTR, int)); +#endif /* USE_FONT_BACKEND */ + #endif /* EMACS_FONTSET_H */ /* arch-tag: c27cef7b-3cab-488a-8398-7a4daa96bb77 diff --git a/src/frame.c b/src/frame.c index b06b541d60c..c5762142541 100644 --- a/src/frame.c +++ b/src/frame.c @@ -23,7 +23,7 @@ Boston, MA 02110-1301, USA. */ #include <stdio.h> #include "lisp.h" -#include "charset.h" +#include "character.h" #ifdef HAVE_X_WINDOWS #include "xterm.h" #endif @@ -54,6 +54,10 @@ Boston, MA 02110-1301, USA. */ #ifdef HAVE_WINDOW_SYSTEM +#ifdef USE_FONT_BACKEND +#include "font.h" +#endif /* USE_FONT_BACKEND */ + /* The name we're using in resource queries. Most often "emacs". */ Lisp_Object Vx_resource_name; @@ -112,6 +116,9 @@ Lisp_Object Qtty_color_mode; Lisp_Object Qtty, Qtty_type; Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth; +#ifdef USE_FONT_BACKEND +Lisp_Object Qfont_backend; +#endif /* USE_FONT_BACKEND */ Lisp_Object Qinhibit_face_set_after_frame_default; Lisp_Object Qface_set_after_frame_default; @@ -326,6 +333,10 @@ make_frame (mini_p) #endif f->size_hint_flags = 0; f->win_gravity = 0; +#ifdef USE_FONT_BACKEND + f->font_driver_list = NULL; + f->font_data_list = NULL; +#endif /* USE_FONT_BACKEND */ root_window = make_window (); if (mini_p) @@ -1474,6 +1485,11 @@ The functions are run with one arg, the frame to be deleted. */) memory. */ free_glyphs (f); +#ifdef USE_FONT_BACKEND + /* Give chance to each font driver to free a frame specific data. */ + font_update_drivers (f, Qnil); +#endif /* USE_FONT_BACKEND */ + /* Mark all the windows that used to be on FRAME as deleted, and then remove the reference to them. */ delete_all_subwindows (XWINDOW (f->root_window)); @@ -2193,7 +2209,7 @@ store_in_alist (alistptr, prop, val) static int frame_name_fnn_p (str, len) char *str; - int len; + EMACS_INT len; { if (len > 1 && str[0] == 'F') { @@ -2834,6 +2850,9 @@ static struct frame_parm_table frame_parms[] = {"right-fringe", &Qright_fringe}, {"wait-for-wm", &Qwait_for_wm}, {"fullscreen", &Qfullscreen}, +#ifdef USE_FONT_BACKEND + {"font-backend", &Qfont_backend} +#endif /* USE_FONT_BACKEND */ }; #ifdef HAVE_WINDOW_SYSTEM @@ -3348,20 +3367,60 @@ x_set_font (f, arg, oldval) Lisp_Object frame; int old_fontset = FRAME_FONTSET(f); +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + int fontset = -1; + Lisp_Object font_object; + + /* ARG is a fontset name, a font name, or a font object. + In the last case, this function never fail. */ + if (STRINGP (arg)) + { + fontset = fs_query_fontset (arg, 0); + if (fontset < 0) + font_object = font_open_by_name (f, SDATA (arg)); + else if (fontset > 0) + { + Lisp_Object ascii_font = fontset_ascii (fontset); + + font_object = font_open_by_name (f, SDATA (ascii_font)); + } + } + else + font_object = arg; + + if (fontset < 0 && ! NILP (font_object)) + fontset = new_fontset_from_font (font_object); + + if (fontset == 0) + /* Refuse the default fontset. */ + result = Qt; + else if (NILP (font_object)) + result = Qnil; + else + result = x_new_fontset2 (f, fontset, font_object); + } + else + { +#endif /* USE_FONT_BACKEND */ CHECK_STRING (arg); fontset_name = Fquery_fontset (arg, Qnil); BLOCK_INPUT; result = (STRINGP (fontset_name) - ? x_new_fontset (f, SDATA (fontset_name)) - : x_new_font (f, SDATA (arg))); + ? x_new_fontset (f, fontset_name) + : x_new_fontset (f, arg)); UNBLOCK_INPUT; +#ifdef USE_FONT_BACKEND + } +#endif if (EQ (result, Qnil)) error ("Font `%s' is not defined", SDATA (arg)); else if (EQ (result, Qt)) - error ("The characters of the given font have varying widths"); + error ("The default fontset can't be used for a frame font"); else if (STRINGP (result)) { set_default_ascii_font (result); @@ -3372,7 +3431,9 @@ x_set_font (f, arg, oldval) if (old_fontset == FRAME_FONTSET (f)) return; } - else if (!NILP (Fequal (result, oldval))) + store_frame_param (f, Qfont, result); + + if (!NILP (Fequal (result, oldval))) return; /* Recalculate toolbar height. */ @@ -3380,7 +3441,6 @@ x_set_font (f, arg, oldval) /* Ensure we redraw it. */ clear_current_matrices (f); - store_frame_param (f, Qfont, result); recompute_basic_faces (f); } else @@ -3401,6 +3461,62 @@ x_set_font (f, arg, oldval) } +#ifdef USE_FONT_BACKEND +void +x_set_font_backend (f, new_value, old_value) + struct frame *f; + Lisp_Object new_value, old_value; +{ + if (! NILP (new_value) + && !CONSP (new_value)) + { + char *p0, *p1; + + CHECK_STRING (new_value); + p0 = p1 = SDATA (new_value); + new_value = Qnil; + while (*p0) + { + while (*p1 && *p1 != ',') p1++; + if (p0 < p1) + new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil), + new_value); + if (*p1) + p1++; + p0 = p1; + } + new_value = Fnreverse (new_value); + } + + if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value))) + return; + + if (FRAME_FONT_OBJECT (f)) + free_all_realized_faces (Qnil); + + new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value); + if (NILP (new_value)) + { + if (NILP (old_value)) + error ("No font backend available"); + font_update_drivers (f, old_value); + error ("None of specified font backends are available"); + } + store_frame_param (f, Qfont_backend, new_value); + + if (FRAME_FONT_OBJECT (f)) + { + Lisp_Object frame; + + XSETFRAME (frame, f); + x_set_font (f, Fframe_parameter (frame, Qfont), Qnil); + ++face_change_count; + ++windows_or_buffers_changed; + } +} +#endif /* USE_FONT_BACKEND */ + + void x_set_fringe_width (f, new_value, old_value) struct frame *f; diff --git a/src/frame.h b/src/frame.h index a9bddbe34b8..ef8d3d7da56 100644 --- a/src/frame.h +++ b/src/frame.h @@ -77,6 +77,8 @@ enum text_cursor_kinds struct terminal; +struct font_driver_list; + struct frame { EMACS_UINT size; @@ -268,6 +270,9 @@ struct frame /* Size of the frame window in pixels. */ int pixel_height, pixel_width; + /* Dots per inch of the screen the frame is on. */ + double resx, resy; + /* These many pixels are the difference between the outer window (i.e. the left and top of the window manager decoration) and FRAME_X_WINDOW. */ int x_pixels_diff, y_pixels_diff; @@ -317,6 +322,12 @@ struct frame } output_data; + /* List of font-drivers available on the frame. */ + struct font_driver_list *font_driver_list; + /* List of data specific to font-driver and frame, but common to + faces. */ + struct font_data_list *font_data_list; + /* Total width of fringes reserved for drawing truncation bitmaps, continuation bitmaps and alike. The width is in canonical char units of the frame. This must currently be the case because window @@ -475,7 +486,7 @@ struct frame typedef struct frame *FRAME_PTR; -#define XFRAME(p) (eassert (GC_FRAMEP(p)),(struct frame *) XPNTR (p)) +#define XFRAME(p) (eassert (FRAMEP(p)),(struct frame *) XPNTR (p)) #define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME)) /* Given a window, return its frame as a Lisp_Object. */ @@ -1005,6 +1016,7 @@ extern Lisp_Object Qscreen_gamma; extern Lisp_Object Qline_spacing; extern Lisp_Object Qwait_for_wm; extern Lisp_Object Qfullscreen; +extern Lisp_Object Qfont_backend; extern Lisp_Object Qleft_fringe, Qright_fringe; extern Lisp_Object Qheight, Qwidth; @@ -1043,8 +1055,10 @@ extern void x_set_offset P_ ((struct frame *, int, int, int)); extern void x_wm_set_icon_position P_ ((struct frame *, int, int)); extern Lisp_Object x_new_font P_ ((struct frame *, char *)); -extern Lisp_Object x_new_fontset P_ ((struct frame *, char *)); - +extern Lisp_Object x_new_fontset P_ ((struct frame *, Lisp_Object)); +#ifdef USE_FONT_BACKEND +extern Lisp_Object x_new_fontset2 P_ ((struct frame *, int, Lisp_Object)); +#endif /* USE_FONT_BACKEND */ /* These are in frame.c */ @@ -1064,6 +1078,7 @@ extern void x_set_fullscreen P_ ((struct frame *, Lisp_Object, Lisp_Object)); extern void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object)); extern void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object)); extern void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object)); +extern void x_set_font_backend P_ ((struct frame *, Lisp_Object, Lisp_Object)); extern void x_set_fringe_width P_ ((struct frame *, Lisp_Object, Lisp_Object)); extern void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object)); extern void x_set_internal_border_width P_ ((struct frame *, Lisp_Object, diff --git a/src/fringe.c b/src/fringe.c index 70e14f51f5f..f24ab34f429 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -586,7 +586,7 @@ draw_fringe_bitmap_1 (w, row, left_p, overlay, which) Lisp_Object face; if ((face = fringe_faces[which], NILP (face)) - || (face_id = lookup_derived_face (f, face, 'A', FRINGE_FACE_ID, 0), + || (face_id = lookup_derived_face (f, face, FRINGE_FACE_ID, 0), face_id < 0)) face_id = FRINGE_FACE_ID; } @@ -1563,7 +1563,7 @@ If FACE is nil, reset face to default fringe face. */) if (!NILP (face)) { face_id = lookup_derived_face (SELECTED_FRAME (), face, - 'A', FRINGE_FACE_ID, 1); + FRINGE_FACE_ID, 1); if (face_id < 0) error ("No such face"); } diff --git a/src/ftfont.c b/src/ftfont.c new file mode 100644 index 00000000000..316f8f3cf09 --- /dev/null +++ b/src/ftfont.c @@ -0,0 +1,1700 @@ +/* ftfont.c -- FreeType font driver. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> + +#include <fontconfig/fontconfig.h> +#include <fontconfig/fcfreetype.h> + +#include "lisp.h" +#include "dispextern.h" +#include "frame.h" +#include "blockinput.h" +#include "character.h" +#include "charset.h" +#include "coding.h" +#include "fontset.h" +#include "font.h" +#include "ftfont.h" + +/* Symbolic type of this font-driver. */ +Lisp_Object Qfreetype; + +/* Fontconfig's generic families and their aliases. */ +static Lisp_Object Qmonospace, Qsans_serif, Qserif, Qmono, Qsans, Qsans__serif; + +/* Flag to tell if FcInit is areadly called or not. */ +static int fc_initialized; + +/* Handle to a FreeType library instance. */ +static FT_Library ft_library; + +/* Cache for FreeType fonts. */ +static Lisp_Object freetype_font_cache; + +/* Fontconfig's charset used for finding fonts of registry + "iso8859-1". */ +static FcCharSet *cs_iso8859_1; + +/* The actual structure for FreeType font that can be casted to struct + font. */ + +struct ftfont_info +{ + struct font font; + FT_Size ft_size; +#ifdef HAVE_LIBOTF + int maybe_otf; /* Flag to tell if this may be OTF or not. */ + OTF *otf; +#endif /* HAVE_LIBOTF */ +}; + +static int ftfont_build_basic_charsets P_ ((void)); +static Lisp_Object ftfont_pattern_entity P_ ((FcPattern *, + Lisp_Object, Lisp_Object)); +static Lisp_Object ftfont_list_generic_family P_ ((Lisp_Object, Lisp_Object, + Lisp_Object)); +Lisp_Object ftfont_font_format P_ ((FcPattern *)); + +#define SYMBOL_FcChar8(SYM) (FcChar8 *) SDATA (SYMBOL_NAME (SYM)) + +static int +ftfont_build_basic_charsets () +{ + FcChar32 c; + + cs_iso8859_1 = FcCharSetCreate (); + if (! cs_iso8859_1) + return -1; + for (c = ' '; c < 127; c++) + if (! FcCharSetAddChar (cs_iso8859_1, c)) + return -1; +#if 0 + /* This part is currently disabled. Should be fixed later. */ + for (c = 192; c < 256; c++) + if (! FcCharSetAddChar (cs_iso8859_1, c)) + return -1; +#endif + return 0; +} + +static Lisp_Object +ftfont_pattern_entity (p, frame, registry) + FcPattern *p; + Lisp_Object frame, registry; +{ + Lisp_Object entity; + FcChar8 *file, *fontformat; + FcCharSet *charset; + char *str; + int numeric; + double dbl; + + if (FcPatternGetString (p, FC_FILE, 0, &file) != FcResultMatch) + return Qnil; + if (FcPatternGetCharSet (p, FC_CHARSET, 0, &charset) != FcResultMatch) + charset = NULL; +#ifdef FC_FONTFORMAT + if (FcPatternGetString (p, FC_FONTFORMAT, 0, &fontformat) != FcResultMatch) +#endif /* FC_FONTFORMAT */ + fontformat = NULL; + + entity = Fmake_vector (make_number (FONT_ENTITY_MAX), null_string); + + ASET (entity, FONT_TYPE_INDEX, Qfreetype); + ASET (entity, FONT_REGISTRY_INDEX, registry); + ASET (entity, FONT_FRAME_INDEX, frame); + ASET (entity, FONT_OBJLIST_INDEX, Qnil); + + if (FcPatternGetString (p, FC_FOUNDRY, 0, (FcChar8 **) &str) == FcResultMatch) + ASET (entity, FONT_FOUNDRY_INDEX, intern_downcase (str, strlen (str))); + if (FcPatternGetString (p, FC_FAMILY, 0, (FcChar8 **) &str) == FcResultMatch) + ASET (entity, FONT_FAMILY_INDEX, intern_downcase (str, strlen (str))); + if (FcPatternGetInteger (p, FC_WEIGHT, 0, &numeric) == FcResultMatch) + { + if (numeric == FC_WEIGHT_REGULAR) + numeric = 100; + ASET (entity, FONT_WEIGHT_INDEX, make_number (numeric)); + } + if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch) + ASET (entity, FONT_SLANT_INDEX, make_number (numeric + 100)); + if (FcPatternGetInteger (p, FC_WIDTH, 0, &numeric) == FcResultMatch) + ASET (entity, FONT_WIDTH_INDEX, make_number (numeric)); + if (FcPatternGetDouble (p, FC_PIXEL_SIZE, 0, &dbl) == FcResultMatch) + ASET (entity, FONT_SIZE_INDEX, make_number (dbl)); + else + ASET (entity, FONT_SIZE_INDEX, make_number (0)); + + if (FcPatternGetInteger (p, FC_SPACING, 0, &numeric) != FcResultMatch) + numeric = -1; + file = FcStrCopy (file); + if (! file) + return Qnil; + + p = FcPatternCreate (); + if (! p) + return Qnil; + + if (FcPatternAddString (p, FC_FILE, file) == FcFalse + || (charset + && FcPatternAddCharSet (p, FC_CHARSET, charset) == FcFalse) +#ifdef FC_FONTFORMAT + || (fontformat + && FcPatternAddString (p, FC_FONTFORMAT, fontformat) == FcFalse) +#endif /* FC_FONTFORMAT */ + || (numeric >= 0 + && FcPatternAddInteger (p, FC_SPACING, numeric) == FcFalse)) + { + FcPatternDestroy (p); + return Qnil; + } + ASET (entity, FONT_EXTRA_INDEX, make_save_value (p, 0)); + return entity; +} + +static Lisp_Object ftfont_generic_family_list; + +static Lisp_Object +ftfont_list_generic_family (spec, frame, registry) + Lisp_Object spec, frame, registry; +{ + Lisp_Object family = AREF (spec, FONT_FAMILY_INDEX); + Lisp_Object slot, list, val; + + if (EQ (family, Qmono)) + family = Qmonospace; + else if (EQ (family, Qsans) || EQ (family, Qsans__serif)) + family = Qsans_serif; + slot = assq_no_quit (family, ftfont_generic_family_list); + if (! CONSP (slot)) + return null_vector; + list = XCDR (slot); + if (EQ (list, Qt)) + { + /* Not yet listed. */ + FcObjectSet *objset = NULL; + FcPattern *pattern = NULL, *pat = NULL; + FcFontSet *fontset = NULL; + FcChar8 *fam; + int i, j; + + objset = FcObjectSetBuild (FC_FOUNDRY, FC_FAMILY, FC_WEIGHT, FC_SLANT, + FC_WIDTH, FC_PIXEL_SIZE, FC_SPACING, + FC_CHARSET, FC_FILE, +#ifdef FC_FONTFORMAT + FC_FONTFORMAT, +#endif /* FC_FONTFORMAT */ + NULL); + if (! objset) + goto err; + pattern = FcPatternBuild (NULL, FC_FAMILY, FcTypeString, + SYMBOL_FcChar8 (family), (char *) 0); + if (! pattern) + goto err; + pat = FcPatternCreate (); + if (! pat) + goto err; + FcConfigSubstitute (NULL, pattern, FcMatchPattern); + for (i = 0, val = Qnil; + FcPatternGetString (pattern, FC_FAMILY, i, &fam) == FcResultMatch; + i++) + { + if (strcmp ((char *) fam, (char *) SYMBOL_FcChar8 (family)) == 0) + continue; + if (! FcPatternAddString (pat, FC_FAMILY, fam)) + goto err; + fontset = FcFontList (NULL, pat, objset); + if (! fontset) + goto err; + /* Here we build the list in reverse order so that the last + loop in this function build a list in the correct + order. */ + for (j = 0; j < fontset->nfont; j++) + { + Lisp_Object entity; + + entity = ftfont_pattern_entity (fontset->fonts[j], + frame, registry); + if (! NILP (entity)) + val = Fcons (entity, val); + } + FcFontSetDestroy (fontset); + fontset = NULL; + FcPatternDel (pat, FC_FAMILY); + } + list = val; + XSETCDR (slot, list); + err: + if (pat) FcPatternDestroy (pat); + if (pattern) FcPatternDestroy (pattern); + if (fontset) FcFontSetDestroy (fontset); + if (objset) FcObjectSetDestroy (objset); + if (EQ (list, Qt)) + return Qnil; + } + ASET (spec, FONT_FAMILY_INDEX, Qnil); + for (val = Qnil; CONSP (list); list = XCDR (list)) + if (font_match_p (spec, XCAR (list))) + val = Fcons (XCAR (list), val); + ASET (spec, FONT_FAMILY_INDEX, family); + return Fvconcat (1, &val); +} + + +static Lisp_Object ftfont_get_cache P_ ((FRAME_PTR)); +static Lisp_Object ftfont_list P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object ftfont_match P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object ftfont_list_family P_ ((Lisp_Object)); +static void ftfont_free_entity P_ ((Lisp_Object)); +static struct font *ftfont_open P_ ((FRAME_PTR, Lisp_Object, int)); +static void ftfont_close P_ ((FRAME_PTR, struct font *)); +static int ftfont_has_char P_ ((Lisp_Object, int)); +static unsigned ftfont_encode_char P_ ((struct font *, int)); +static int ftfont_text_extents P_ ((struct font *, unsigned *, int, + struct font_metrics *)); +static int ftfont_get_bitmap P_ ((struct font *, unsigned, + struct font_bitmap *, int)); +static int ftfont_anchor_point P_ ((struct font *, unsigned, int, + int *, int *)); +static Lisp_Object ftfont_shape P_ ((Lisp_Object)); + +struct font_driver ftfont_driver = + { + 0, /* Qfreetype */ + ftfont_get_cache, + ftfont_list, + ftfont_match, + ftfont_list_family, + ftfont_free_entity, + ftfont_open, + ftfont_close, + /* We can't draw a text without device dependent functions. */ + NULL, + NULL, + ftfont_has_char, + ftfont_encode_char, + ftfont_text_extents, + /* We can't draw a text without device dependent functions. */ + NULL, + ftfont_get_bitmap, + NULL, + NULL, + NULL, + ftfont_anchor_point, + NULL, + NULL, + NULL, + NULL, +#ifdef HAVE_M17N_FLT + ftfont_shape +#else /* not HAVE_M17N_FLT */ + NULL +#endif /* not HAVE_M17N_FLT */ + }; + +extern Lisp_Object QCname; + +static Lisp_Object +ftfont_get_cache (f) + FRAME_PTR f; +{ + return freetype_font_cache; +} + +struct OpenTypeSpec +{ + Lisp_Object script; + unsigned int script_tag, langsys_tag; + int nfeatures[2]; + unsigned int *features[2]; +}; + +#define OTF_SYM_TAG(SYM, TAG) \ + do { \ + unsigned char *p = SDATA (SYMBOL_NAME (SYM)); \ + TAG = (p[0] << 24) | (p[1] << 16) | (p[2] << 8) | p[3]; \ + } while (0) + +#define OTF_TAG_STR(TAG, P) \ + do { \ + (P)[0] = (char) (TAG >> 24); \ + (P)[1] = (char) ((TAG >> 16) & 0xFF); \ + (P)[2] = (char) ((TAG >> 8) & 0xFF); \ + (P)[3] = (char) (TAG & 0xFF); \ + (P)[4] = '\0'; \ + } while (0) + +static struct OpenTypeSpec * +ftfont_get_open_type_spec (Lisp_Object otf_spec) +{ + struct OpenTypeSpec *spec = malloc (sizeof (struct OpenTypeSpec)); + Lisp_Object val; + int i, j, negative; + + if (! spec) + return NULL; + spec->script = XCAR (otf_spec); + if (! NILP (val)) + { + OTF_SYM_TAG (spec->script, spec->script_tag); + val = assq_no_quit (spec->script, Votf_script_alist); + if (CONSP (val) && SYMBOLP (XCDR (val))) + spec->script = XCDR (val); + else + spec->script = Qnil; + } + else + spec->script_tag = 0x44464C54; /* "DFLT" */ + otf_spec = XCDR (otf_spec); + val = XCAR (otf_spec); + if (! NILP (val)) + OTF_SYM_TAG (val, spec->langsys_tag); + else + spec->langsys_tag = 0; + spec->nfeatures[0] = spec->nfeatures[1] = 0; + for (i = 0; i < 2; i++) + { + Lisp_Object len; + + otf_spec = XCDR (otf_spec); + if (NILP (otf_spec)) + break; + val = XCAR (otf_spec); + if (NILP (val)) + continue; + len = Flength (val); + spec->features[i] = malloc (sizeof (int) * XINT (len)); + if (! spec->features[i]) + { + if (i > 0 && spec->features[0]) + free (spec->features[0]); + free (spec); + return NULL; + } + for (j = 0, negative = 0; CONSP (val); val = XCDR (val)) + { + if (NILP (XCAR (val))) + negative = 1; + else + { + unsigned int tag; + + OTF_SYM_TAG (XCAR (val), tag); + spec->features[i][j++] = negative ? tag & 0x80000000 : tag; + } + } + spec->nfeatures[i] = j; + } + return spec; +} + +static Lisp_Object +ftfont_list (frame, spec) + Lisp_Object frame, spec; +{ + Lisp_Object val, tmp, extra; + int i; + FcPattern *pattern = NULL; + FcCharSet *charset = NULL; + FcLangSet *langset = NULL; + FcFontSet *fontset = NULL; + FcObjectSet *objset = NULL; + Lisp_Object script; + Lisp_Object registry = Qunicode_bmp; + struct OpenTypeSpec *otspec= NULL; + int weight = 0; + double dpi = -1; + int spacing = -1; + int scalable = -1; + char otlayout[15]; /* For "otlayout:XXXX" */ + + val = null_vector; + + if (! fc_initialized) + { + FcInit (); + fc_initialized = 1; + } + + if (! NILP (AREF (spec, FONT_ADSTYLE_INDEX)) + && ! EQ (AREF (spec, FONT_ADSTYLE_INDEX), null_string)) + return val; + if (! NILP (AREF (spec, FONT_SLANT_INDEX)) + && XINT (AREF (spec, FONT_SLANT_INDEX)) < 100) + /* Fontconfig doesn't support reverse-italic/obligue. */ + return val; + + if (! NILP (AREF (spec, FONT_REGISTRY_INDEX))) + { + registry = AREF (spec, FONT_REGISTRY_INDEX); + if (EQ (registry, Qiso8859_1)) + { + if (! cs_iso8859_1 + && ftfont_build_basic_charsets () < 0) + return Qnil; + charset = cs_iso8859_1; + } + else if (! EQ (registry, Qiso10646_1) + && ! EQ (registry, Qunicode_bmp) + && ! EQ (registry, Qunicode_sip)) + return val; + } + + otlayout[0] = '\0'; + script = Qnil; + for (extra = AREF (spec, FONT_EXTRA_INDEX); + CONSP (extra); extra = XCDR (extra)) + { + Lisp_Object key, val; + + tmp = XCAR (extra); + key = XCAR (tmp), val = XCDR (tmp); + if (EQ (key, QCotf)) + { + otspec = ftfont_get_open_type_spec (val); + if (! otspec) + return null_vector; + strcat (otlayout, "otlayout:"); + OTF_TAG_STR (otspec->script_tag, otlayout + 9); + script = otspec->script; + } + else if (EQ (key, QClanguage)) + { + langset = FcLangSetCreate (); + if (! langset) + goto err; + if (SYMBOLP (val)) + { + if (! FcLangSetAdd (langset, SYMBOL_FcChar8 (val))) + goto err; + } + else + for (; CONSP (val); val = XCDR (val)) + if (SYMBOLP (XCAR (val)) + && ! FcLangSetAdd (langset, SYMBOL_FcChar8 (XCAR (val)))) + goto err; + } + else if (EQ (key, QCscript)) + script = val; + else if (EQ (key, QCdpi)) + dpi = XINT (val); + else if (EQ (key, QCspacing)) + spacing = XINT (val); + else if (EQ (key, QCscalable)) + scalable = ! NILP (val); + } + + if (! NILP (script) && ! charset) + { + Lisp_Object chars = assq_no_quit (script, Vscript_representative_chars); + + if (CONSP (chars)) + { + charset = FcCharSetCreate (); + if (! charset) + goto err; + for (chars = XCDR (chars); CONSP (chars); chars = XCDR (chars)) + if (CHARACTERP (XCAR (chars)) + && ! FcCharSetAddChar (charset, XUINT (XCAR (chars)))) + goto err; + } + } + + pattern = FcPatternCreate (); + if (! pattern) + goto err; + tmp = AREF (spec, FONT_FOUNDRY_INDEX); + if (SYMBOLP (tmp) && ! NILP (tmp) + && ! FcPatternAddString (pattern, FC_FOUNDRY, SYMBOL_FcChar8 (tmp))) + goto err; + tmp = AREF (spec, FONT_FAMILY_INDEX); + if (SYMBOLP (tmp) && ! NILP (tmp) + && ! FcPatternAddString (pattern, FC_FAMILY, SYMBOL_FcChar8 (tmp))) + goto err; + /* Emacs conventionally doesn't distinguish normal, regular, and + medium weight, but fontconfig does. So, we can't restrict font + listing by weight. We check it after getting a list. */ + tmp = AREF (spec, FONT_WEIGHT_INDEX); + if (INTEGERP (tmp)) + weight = XINT (tmp); + tmp = AREF (spec, FONT_SLANT_INDEX); + if (INTEGERP (tmp) + && ! FcPatternAddInteger (pattern, FC_SLANT, XINT (tmp) - 100)) + goto err; + tmp = AREF (spec, FONT_WIDTH_INDEX); + if (INTEGERP (tmp) + && ! FcPatternAddInteger (pattern, FC_WIDTH, XINT (tmp))) + goto err; + + if (charset + && ! FcPatternAddCharSet (pattern, FC_CHARSET, charset)) + goto err; + if (langset + && ! FcPatternAddLangSet (pattern, FC_LANG, langset)) + goto err; + if (dpi >= 0 + && ! FcPatternAddDouble (pattern, FC_DPI, dpi)) + goto err; + if (spacing >= 0 + && ! FcPatternAddInteger (pattern, FC_SPACING, spacing)) + goto err; + if (scalable >= 0 + && ! FcPatternAddBool (pattern, FC_SCALABLE, scalable ? FcTrue : FcFalse)) + goto err; + + objset = FcObjectSetBuild (FC_FOUNDRY, FC_FAMILY, FC_WEIGHT, FC_SLANT, + FC_WIDTH, FC_PIXEL_SIZE, FC_SPACING, + FC_CHARSET, FC_FILE, +#ifdef FC_FONTFORMAT + FC_FONTFORMAT, +#endif /* FC_FONTFORMAT */ + NULL); + if (! objset) + goto err; + if (otlayout[0]) + { +#ifdef FC_CAPABILITY + if (! FcObjectSetAdd (objset, FC_CAPABILITY)) + goto err; +#else /* not FC_CAPABILITY */ + goto finish; +#endif /* not FC_CAPABILITY */ + } + + fontset = FcFontList (NULL, pattern, objset); + if (! fontset) + goto err; + + if (fontset->nfont > 0) + { + double pixel_size; + + if (NILP (AREF (spec, FONT_SIZE_INDEX))) + pixel_size = 0; + else + pixel_size = XINT (AREF (spec, FONT_SIZE_INDEX)); + + for (i = 0, val = Qnil; i < fontset->nfont; i++) + { + Lisp_Object entity; + + if (pixel_size > 0) + { + double this; + + if (FcPatternGetDouble (fontset->fonts[i], FC_PIXEL_SIZE, 0, + &this) == FcResultMatch + && ((this < pixel_size - FONT_PIXEL_SIZE_QUANTUM) + || (this > pixel_size + FONT_PIXEL_SIZE_QUANTUM))) + continue; + } + if (weight > 0) + { + int this; + + if (FcPatternGetInteger (fontset->fonts[i], FC_WEIGHT, 0, + &this) != FcResultMatch + || (this != weight + && (weight != 100 + || this < FC_WEIGHT_REGULAR + || this > FC_WEIGHT_MEDIUM))) + continue; + } +#ifdef FC_CAPABILITY + if (otlayout[0]) + { + FcChar8 *this; + + if (FcPatternGetString (fontset->fonts[i], FC_CAPABILITY, 0, + &this) != FcResultMatch + || ! strstr ((char *) this, otlayout)) + continue; + } +#endif /* FC_CAPABILITY */ +#ifdef HAVE_LIBOTF + if (otspec) + { + FcChar8 *file; + OTF *otf; + + if (FcPatternGetString (fontset->fonts[i], FC_FILE, 0, &file) + != FcResultMatch) + continue; + otf = OTF_open ((char *) file); + if (! otf) + continue; + if (OTF_check_features (otf, 1, + otspec->script_tag, otspec->langsys_tag, + otspec->features[0], + otspec->nfeatures[0]) != 1 + || OTF_check_features (otf, 0, + otspec->script_tag, otspec->langsys_tag, + otspec->features[1], + otspec->nfeatures[1]) != 1) + continue; + } +#endif /* HAVE_LIBOTF */ + entity = ftfont_pattern_entity (fontset->fonts[i], frame, registry); + if (! NILP (entity)) + val = Fcons (entity, val); + } + val = Fvconcat (1, &val); + } + else if (! NILP (AREF (spec, FONT_FAMILY_INDEX))) + val = ftfont_list_generic_family (spec, frame, registry); + goto finish; + + err: + /* We come here because of unexpected error in fontconfig API call + (usually insufficient memory). */ + val = Qnil; + + finish: + if (charset && charset != cs_iso8859_1) FcCharSetDestroy (charset); + if (objset) FcObjectSetDestroy (objset); + if (fontset) FcFontSetDestroy (fontset); + if (langset) FcLangSetDestroy (langset); + if (pattern) FcPatternDestroy (pattern); + if (otspec) + { + if (otspec->nfeatures[0] > 0) + free (otspec->features[0]); + if (otspec->nfeatures[1] > 0) + free (otspec->features[1]); + free (otspec); + } + return val; +} + +static Lisp_Object +ftfont_match (frame, spec) + Lisp_Object frame, spec; +{ + Lisp_Object extra, val, entity; + FcPattern *pattern = NULL, *match = NULL; + FcResult result; + + if (! fc_initialized) + { + FcInit (); + fc_initialized = 1; + } + + extra = AREF (spec, FONT_EXTRA_INDEX); + val = assq_no_quit (QCname, extra); + if (! CONSP (val) || ! STRINGP (XCDR (val))) + return Qnil; + + entity = Qnil; + pattern = FcNameParse (SDATA (XCDR (val))); + if (pattern) + { + if (FcConfigSubstitute (NULL, pattern, FcMatchPattern) == FcTrue) + { + FcDefaultSubstitute (pattern); + match = FcFontMatch (NULL, pattern, &result); + if (match) + { + entity = ftfont_pattern_entity (match, frame, Qunicode_bmp); + FcPatternDestroy (match); + } + } + FcPatternDestroy (pattern); + } + + return entity; +} + +static Lisp_Object +ftfont_list_family (frame) + Lisp_Object frame; +{ + Lisp_Object list; + FcPattern *pattern = NULL; + FcFontSet *fontset = NULL; + FcObjectSet *objset = NULL; + int i; + + if (! fc_initialized) + { + FcInit (); + fc_initialized = 1; + } + + pattern = FcPatternCreate (); + if (! pattern) + goto finish; + objset = FcObjectSetBuild (FC_FAMILY, NULL); + if (! objset) + goto finish; + fontset = FcFontList (NULL, pattern, objset); + if (! fontset) + goto finish; + + list = Qnil; + for (i = 0; i < fontset->nfont; i++) + { + FcPattern *pat = fontset->fonts[i]; + FcChar8 *str; + + if (FcPatternGetString (pat, FC_FAMILY, 0, &str) == FcResultMatch) + list = Fcons (intern_downcase ((char *) str, strlen ((char *) str)), + list); + } + + finish: + if (objset) FcObjectSetDestroy (objset); + if (fontset) FcFontSetDestroy (fontset); + if (pattern) FcPatternDestroy (pattern); + + return list; +} + + +static void +ftfont_free_entity (entity) + Lisp_Object entity; +{ + Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX); + FcPattern *pattern = XSAVE_VALUE (val)->pointer; + + FcPatternDestroy (pattern); +} + +static struct font * +ftfont_open (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + struct ftfont_info *ftfont_info; + struct font *font; + FT_Face ft_face; + FT_Size ft_size; + FT_UInt size; + Lisp_Object val; + FcPattern *pattern; + FcChar8 *file; + int spacing; + char *name; + int len; + + val = AREF (entity, FONT_EXTRA_INDEX); + if (XTYPE (val) != Lisp_Misc + || XMISCTYPE (val) != Lisp_Misc_Save_Value) + return NULL; + pattern = XSAVE_VALUE (val)->pointer; + if (XSAVE_VALUE (val)->integer == 0) + { + /* We have not yet created FT_Face for this font. */ + if (! ft_library + && FT_Init_FreeType (&ft_library) != 0) + return NULL; + if (FcPatternGetString (pattern, FC_FILE, 0, &file) != FcResultMatch) + return NULL; + if (FT_New_Face (ft_library, (char *) file, 0, &ft_face) != 0) + return NULL; + FcPatternAddFTFace (pattern, FC_FT_FACE, ft_face); + ft_size = ft_face->size; + } + else + { + if (FcPatternGetFTFace (pattern, FC_FT_FACE, 0, &ft_face) + != FcResultMatch) + return NULL; + if (FT_New_Size (ft_face, &ft_size) != 0) + return NULL; + if (FT_Activate_Size (ft_size) != 0) + { + FT_Done_Size (ft_size); + return NULL; + } + } + + size = XINT (AREF (entity, FONT_SIZE_INDEX)); + if (size == 0) + size = pixel_size; + if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) + { + if (XSAVE_VALUE (val)->integer == 0) + FT_Done_Face (ft_face); + return NULL; + } + + ftfont_info = malloc (sizeof (struct ftfont_info)); + if (! ftfont_info) + return NULL; + ftfont_info->ft_size = ft_size; +#ifdef HAVE_LIBOTF + ftfont_info->maybe_otf = ft_face->face_flags & FT_FACE_FLAG_SFNT; + ftfont_info->otf = NULL; +#endif /* HAVE_LIBOTF */ + + font = (struct font *) ftfont_info; + font->format = ftfont_font_format (pattern); + font->entity = entity; + font->pixel_size = size; + font->driver = &ftfont_driver; + len = 96; + name = malloc (len); + while (name && font_unparse_fcname (entity, pixel_size, name, len) < 0) + { + char *new = realloc (name, len += 32); + + if (! new) + free (name); + name = new; + } + font->font.full_name = font->font.name = name; + font->file_name = (char *) file; + font->font.size = ft_face->size->metrics.max_advance >> 6; + if (font->font.size <= 0) + font->font.size = size; + font->font.charset = font->encoding_charset = font->repertory_charset = -1; + font->ascent = ft_face->size->metrics.ascender >> 6; + font->descent = - ft_face->size->metrics.descender >> 6; + font->font.height = font->ascent + font->descent; + if (FcPatternGetInteger (pattern, FC_SPACING, 0, &spacing) != FcResultMatch) + spacing = FC_PROPORTIONAL; + if (spacing != FC_PROPORTIONAL) + font->font.average_width = font->font.space_width = font->font.size; + else + { + int i; + + for (i = 32; i < 127; i++) + { + if (FT_Load_Char (ft_face, i, FT_LOAD_DEFAULT) != 0) + break; + if (i == 32) + font->font.space_width = ft_face->glyph->metrics.horiAdvance >> 6; + font->font.average_width += ft_face->glyph->metrics.horiAdvance >> 6; + } + if (i == 127) + { + /* The font contains all ASCII printable characters. */ + font->font.average_width /= 95; + } + else + { + if (i == 32) + font->font.space_width = font->font.size; + font->font.average_width = font->font.size; + } + } + + /* Unfortunately FreeType doesn't provide a way to get minimum char + width. So, we use space_width instead. */ + font->min_width = font->font.space_width; + + font->font.baseline_offset = 0; + font->font.relative_compose = 0; + font->font.default_ascent = 0; + font->font.vertical_centering = 0; + + (XSAVE_VALUE (val)->integer)++; + + return font; +} + +static void +ftfont_close (f, font) + FRAME_PTR f; + struct font *font; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + Lisp_Object entity = font->entity; + Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX); + + (XSAVE_VALUE (val)->integer)--; + if (XSAVE_VALUE (val)->integer == 0) + { + FT_Done_Face (ftfont_info->ft_size->face); +#ifdef HAVE_LIBOTF + if (ftfont_info->otf) + OTF_close (ftfont_info->otf); +#endif + } + else + FT_Done_Size (ftfont_info->ft_size); + + free (font); +} + +static int +ftfont_has_char (entity, c) + Lisp_Object entity; + int c; +{ + Lisp_Object val; + FcPattern *pattern; + FcCharSet *charset; + + val = AREF (entity, FONT_EXTRA_INDEX); + pattern = XSAVE_VALUE (val)->pointer; + if (FcPatternGetCharSet (pattern, FC_CHARSET, 0, &charset) != FcResultMatch) + return -1; + return (FcCharSetHasChar (charset, (FcChar32) c) == FcTrue); +} + +static unsigned +ftfont_encode_char (font, c) + struct font *font; + int c; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + FT_Face ft_face = ftfont_info->ft_size->face; + FT_ULong charcode = c; + FT_UInt code = FT_Get_Char_Index (ft_face, charcode); + + return (code > 0 ? code : FONT_INVALID_CODE); +} + +static int +ftfont_text_extents (font, code, nglyphs, metrics) + struct font *font; + unsigned *code; + int nglyphs; + struct font_metrics *metrics; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + FT_Face ft_face = ftfont_info->ft_size->face; + int width = 0; + int i; + + if (ftfont_info->ft_size != ft_face->size) + FT_Activate_Size (ftfont_info->ft_size); + if (metrics) + bzero (metrics, sizeof (struct font_metrics)); + for (i = 0; i < nglyphs; i++) + { + if (FT_Load_Glyph (ft_face, code[i], FT_LOAD_DEFAULT) == 0) + { + FT_Glyph_Metrics *m = &ft_face->glyph->metrics; + + if (metrics) + { + if (metrics->lbearing > width + (m->horiBearingX >> 6)) + metrics->lbearing = width + (m->horiBearingX >> 6); + if (metrics->rbearing + < width + ((m->horiBearingX + m->width) >> 6)) + metrics->rbearing + = width + ((m->horiBearingX + m->width) >> 6); + if (metrics->ascent < (m->horiBearingY >> 6)) + metrics->ascent = m->horiBearingY >> 6; + if (metrics->descent > ((m->horiBearingY + m->height) >> 6)) + metrics->descent = (m->horiBearingY + m->height) >> 6; + } + width += m->horiAdvance >> 6; + } + else + { + width += font->font.space_width; + } + } + if (metrics) + metrics->width = width; + + return width; +} + +static int +ftfont_get_bitmap (font, code, bitmap, bits_per_pixel) + struct font *font; + unsigned code; + struct font_bitmap *bitmap; + int bits_per_pixel; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + FT_Face ft_face = ftfont_info->ft_size->face; + FT_Int32 load_flags = FT_LOAD_RENDER; + + if (ftfont_info->ft_size != ft_face->size) + FT_Activate_Size (ftfont_info->ft_size); + if (bits_per_pixel == 1) + { +#ifdef FT_LOAD_TARGET_MONO + load_flags |= FT_LOAD_TARGET_MONO; +#else + load_flags |= FT_LOAD_MONOCHROME; +#endif + } + else if (bits_per_pixel != 8) + /* We don't support such a rendering. */ + return -1; + + if (FT_Load_Glyph (ft_face, code, load_flags) != 0) + return -1; + bitmap->bits_per_pixel + = (ft_face->glyph->bitmap.pixel_mode == FT_PIXEL_MODE_MONO ? 1 + : ft_face->glyph->bitmap.pixel_mode == FT_PIXEL_MODE_GRAY ? 8 + : ft_face->glyph->bitmap.pixel_mode == FT_PIXEL_MODE_LCD ? 8 + : ft_face->glyph->bitmap.pixel_mode == FT_PIXEL_MODE_LCD_V ? 8 + : -1); + if (bitmap->bits_per_pixel < 0) + /* We don't suport that kind of pixel mode. */ + return -1; + bitmap->rows = ft_face->glyph->bitmap.rows; + bitmap->width = ft_face->glyph->bitmap.width; + bitmap->pitch = ft_face->glyph->bitmap.pitch; + bitmap->buffer = ft_face->glyph->bitmap.buffer; + bitmap->left = ft_face->glyph->bitmap_left; + bitmap->top = ft_face->glyph->bitmap_top; + bitmap->advance = ft_face->glyph->metrics.horiAdvance >> 6; + bitmap->extra = NULL; + + return 0; +} + +static int +ftfont_anchor_point (font, code, index, x, y) + struct font *font; + unsigned code; + int index; + int *x, *y; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + FT_Face ft_face = ftfont_info->ft_size->face; + + if (ftfont_info->ft_size != ft_face->size) + FT_Activate_Size (ftfont_info->ft_size); + if (FT_Load_Glyph (ft_face, code, FT_LOAD_DEFAULT) != 0) + return -1; + if (ft_face->glyph->format != FT_GLYPH_FORMAT_OUTLINE) + return -1; + if (index >= ft_face->glyph->outline.n_points) + return -1; + *x = ft_face->glyph->outline.points[index].x; + *y = ft_face->glyph->outline.points[index].y; + return 0; +} + +#ifdef HAVE_LIBOTF +#ifdef HAVE_M17N_FLT + +struct MFLTFontFT +{ + MFLTFont flt_font; + struct font *font; + FT_Face ft_face; + OTF *otf; +}; + +static int +ftfont_get_glyph_id (font, gstring, from, to) + MFLTFont *font; + MFLTGlyphString *gstring; + int from, to; +{ + struct MFLTFontFT *flt_font_ft = (struct MFLTFontFT *) font; + FT_Face ft_face = flt_font_ft->ft_face; + MFLTGlyph *g; + + for (g = gstring->glyphs + from; from < to; g++, from++) + if (! g->encoded) + { + FT_UInt code = FT_Get_Char_Index (ft_face, g->code); + + g->code = code > 0 ? code : FONT_INVALID_CODE; + g->encoded = 1; + } + return 0; +} + +static int +ftfont_get_metrics (font, gstring, from, to) + MFLTFont *font; + MFLTGlyphString *gstring; + int from, to; +{ + struct MFLTFontFT *flt_font_ft = (struct MFLTFontFT *) font; + FT_Face ft_face = flt_font_ft->ft_face; + MFLTGlyph *g; + + for (g = gstring->glyphs + from; from < to; g++, from++) + if (! g->measured) + { + if (g->code != FONT_INVALID_CODE) + { + FT_Glyph_Metrics *m; + + if (FT_Load_Glyph (ft_face, g->code, FT_LOAD_DEFAULT) != 0) + abort (); + m = &ft_face->glyph->metrics; + + g->lbearing = m->horiBearingX; + g->rbearing = m->horiBearingX + m->width; + g->ascent = m->horiBearingY; + g->descent = m->height - m->horiBearingY; + g->xadv = m->horiAdvance; + } + else + { + g->lbearing = 0; + g->rbearing = g->xadv = flt_font_ft->font->font.space_width << 6; + g->ascent = flt_font_ft->font->ascent << 6; + g->descent = flt_font_ft->font->descent << 6; + } + g->yadv = 0; + g->measured = 1; + } + return 0; +} + +static int +ftfont_check_otf (MFLTFont *font, MFLTOtfSpec *spec) +{ + struct MFLTFontFT *flt_font_ft = (struct MFLTFontFT *) font; + OTF *otf = flt_font_ft->otf; + OTF_Tag *tags; + int i, n, negative; + + for (i = 0; i < 2; i++) + { + if (! spec->features[i]) + continue; + for (n = 0; spec->features[i][n]; n++); + tags = alloca (sizeof (OTF_Tag) * n); + for (n = 0, negative = 0; spec->features[i][n]; n++) + { + if (spec->features[i][n] == 0xFFFFFFFF) + negative = 1; + else if (negative) + tags[n - 1] = spec->features[i][n] | 0x80000000; + else + tags[n] = spec->features[i][n]; + } + if (n - negative > 0 + && OTF_check_features (otf, i == 0, spec->script, spec->langsys, + tags, n - negative) != 1) + return 0; + } + return 1; +} + +#define DEVICE_DELTA(table, size) \ + (((size) >= (table).StartSize && (size) <= (table).EndSize) \ + ? (table).DeltaValue[(size) - (table).StartSize] << 6 \ + : 0) + +static void +adjust_anchor (FT_Face ft_face, OTF_Anchor *anchor, + unsigned code, int x_ppem, int y_ppem, int *x, int *y) +{ + if (anchor->AnchorFormat == 2) + { + FT_Outline *outline; + int ap = anchor->f.f1.AnchorPoint; + + FT_Load_Glyph (ft_face, (FT_UInt) code, FT_LOAD_MONOCHROME); + outline = &ft_face->glyph->outline; + if (ap < outline->n_points) + { + *x = outline->points[ap].x << 6; + *y = outline->points[ap].y << 6; + } + } + else if (anchor->AnchorFormat == 3) + { + if (anchor->f.f2.XDeviceTable.offset) + *x += DEVICE_DELTA (anchor->f.f2.XDeviceTable, x_ppem); + if (anchor->f.f2.YDeviceTable.offset) + *y += DEVICE_DELTA (anchor->f.f2.YDeviceTable, y_ppem); + } +} + +static OTF_GlyphString otf_gstring; + +static int +ftfont_drive_otf (font, spec, in, from, to, out, adjustment) + MFLTFont *font; + MFLTOtfSpec *spec; + MFLTGlyphString *in; + int from, to; + MFLTGlyphString *out; + MFLTGlyphAdjustment *adjustment; +{ + struct MFLTFontFT *flt_font_ft = (struct MFLTFontFT *) font; + FT_Face ft_face = flt_font_ft->ft_face; + OTF *otf = flt_font_ft->otf; + int len = to - from; + int i, j, gidx; + OTF_Glyph *otfg; + char script[5], *langsys = NULL; + char *gsub_features = NULL, *gpos_features = NULL; + + if (len == 0) + return from; + OTF_tag_name (spec->script, script); + if (spec->langsys) + { + langsys = alloca (5); + OTF_tag_name (spec->langsys, langsys); + } + for (i = 0; i < 2; i++) + { + char *p; + + if (spec->features[i] && spec->features[i][1] != 0xFFFFFFFF) + { + for (j = 0; spec->features[i][j]; j++); + if (i == 0) + p = gsub_features = alloca (6 * j); + else + p = gpos_features = alloca (6 * j); + for (j = 0; spec->features[i][j]; j++) + { + if (spec->features[i][j] == 0xFFFFFFFF) + *p++ = '*', *p++ = ','; + else + { + OTF_tag_name (spec->features[i][j], p); + p[4] = ','; + p += 5; + } + } + *--p = '\0'; + } + } + + if (otf_gstring.size == 0) + { + otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len); + otf_gstring.size = len; + } + else if (otf_gstring.size < len) + { + otf_gstring.glyphs = (OTF_Glyph *) realloc (otf_gstring.glyphs, + sizeof (OTF_Glyph) * len); + otf_gstring.size = len; + } + otf_gstring.used = len; + memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len); + for (i = 0; i < len; i++) + { + otf_gstring.glyphs[i].c = in->glyphs[from + i].c; + otf_gstring.glyphs[i].glyph_id = in->glyphs[from + i].code; + } + + OTF_drive_gdef (otf, &otf_gstring); + gidx = out->used; + + if (gsub_features) + { + if (OTF_drive_gsub (otf, &otf_gstring, script, langsys, gsub_features) + < 0) + goto simple_copy; + if (out->allocated < out->used + otf_gstring.used) + return -2; + for (i = 0, otfg = otf_gstring.glyphs; i < otf_gstring.used; ) + { + OTF_Glyph *endg; + MFLTGlyph *g; + int min_from, max_to; + int j; + + g = out->glyphs + out->used; + *g = in->glyphs[from + otfg->f.index.from]; + if (g->code != otfg->glyph_id) + { + g->c = 0; + g->code = otfg->glyph_id; + g->measured = 0; + } + out->used++; + min_from = g->from; + max_to = g->to; + if (otfg->f.index.from < otfg->f.index.to) + { + /* OTFG substitutes multiple glyphs in IN. */ + for (j = from + otfg->f.index.from + 1; + j <= from + otfg->f.index.to; j++) + { + if (min_from > in->glyphs[j].from) + min_from = in->glyphs[j].from; + if (max_to < in->glyphs[j].to) + max_to = in->glyphs[j].to; + } + g->from = min_from; + g->to = max_to; + } + for (i++, otfg++; (i < otf_gstring.used + && otfg->f.index.from == otfg[-1].f.index.from); + i++, otfg++) + { + g = out->glyphs + out->used; + *g = in->glyphs[from + otfg->f.index.to]; + if (g->code != otfg->glyph_id) + { + g->c = 0; + g->code = otfg->glyph_id; + g->measured = 0; + } + out->used++; + } + } + } + else + { + if (out->allocated < out->used + len) + return -2; + for (i = 0; i < len; i++) + out->glyphs[out->used++] = in->glyphs[from + i]; + } + + if (gpos_features) + { + MFLTGlyph *base = NULL, *mark = NULL, *g; + int x_ppem, y_ppem, x_scale, y_scale; + + if (OTF_drive_gpos (otf, &otf_gstring, script, langsys, gpos_features) + < 0) + return to; + + x_ppem = ft_face->size->metrics.x_ppem; + y_ppem = ft_face->size->metrics.y_ppem; + x_scale = ft_face->size->metrics.x_scale; + y_scale = ft_face->size->metrics.y_scale; + + for (i = 0, otfg = otf_gstring.glyphs, g = out->glyphs + gidx; + i < otf_gstring.used; i++, otfg++, g++) + { + MFLTGlyph *prev; + + if (! otfg->glyph_id) + continue; + switch (otfg->positioning_type) + { + case 0: + break; + case 1: /* Single */ + case 2: /* Pair */ + { + int format = otfg->f.f1.format; + + if (format & OTF_XPlacement) + adjustment[i].xoff + = otfg->f.f1.value->XPlacement * x_scale / 0x10000; + if (format & OTF_XPlaDevice) + adjustment[i].xoff + += DEVICE_DELTA (otfg->f.f1.value->XPlaDevice, x_ppem); + if (format & OTF_YPlacement) + adjustment[i].yoff + = - (otfg->f.f1.value->YPlacement * y_scale / 0x10000); + if (format & OTF_YPlaDevice) + adjustment[i].yoff + -= DEVICE_DELTA (otfg->f.f1.value->YPlaDevice, y_ppem); + if (format & OTF_XAdvance) + adjustment[i].xadv + += otfg->f.f1.value->XAdvance * x_scale / 0x10000; + if (format & OTF_XAdvDevice) + adjustment[i].xadv + += DEVICE_DELTA (otfg->f.f1.value->XAdvDevice, x_ppem); + if (format & OTF_YAdvance) + adjustment[i].yadv + += otfg->f.f1.value->YAdvance * y_scale / 0x10000; + if (format & OTF_YAdvDevice) + adjustment[i].yadv + += DEVICE_DELTA (otfg->f.f1.value->YAdvDevice, y_ppem); + adjustment[i].set = 1; + } + break; + case 3: /* Cursive */ + /* Not yet supported. */ + break; + case 4: /* Mark-to-Base */ + case 5: /* Mark-to-Ligature */ + if (! base) + break; + prev = base; + goto label_adjust_anchor; + default: /* i.e. case 6 Mark-to-Mark */ + if (! mark) + break; + prev = mark; + + label_adjust_anchor: + { + int base_x, base_y, mark_x, mark_y; + int this_from, this_to; + + base_x = otfg->f.f4.base_anchor->XCoordinate * x_scale / 0x10000; + base_y = otfg->f.f4.base_anchor->YCoordinate * y_scale / 0x10000; + mark_x = otfg->f.f4.mark_anchor->XCoordinate * x_scale / 0x10000; + mark_y = otfg->f.f4.mark_anchor->YCoordinate * y_scale / 0x10000;; + + if (otfg->f.f4.base_anchor->AnchorFormat != 1) + adjust_anchor (ft_face, otfg->f.f4.base_anchor, + prev->code, x_ppem, y_ppem, &base_x, &base_y); + if (otfg->f.f4.mark_anchor->AnchorFormat != 1) + adjust_anchor (ft_face, otfg->f.f4.mark_anchor, g->code, + x_ppem, y_ppem, &mark_x, &mark_y); + adjustment[i].xoff = (base_x - mark_x); + adjustment[i].yoff = - (base_y - mark_y); + adjustment[i].back = (g - prev); + adjustment[i].xadv = 0; + adjustment[i].advance_is_absolute = 1; + adjustment[i].set = 1; + this_from = g->from; + this_to = g->to; + for (j = 0; prev + j < g; j++) + { + if (this_from > prev[j].from) + this_from = prev[j].from; + if (this_to < prev[j].to) + this_to = prev[j].to; + } + for (; prev <= g; prev++) + { + prev->from = this_from; + prev->to = this_to; + } + } + } + if (otfg->GlyphClass == OTF_GlyphClass0) + base = mark = g; + else if (otfg->GlyphClass == OTF_GlyphClassMark) + mark = g; + else + base = g; + } + } + return to; + + simple_copy: + if (out->allocated < out->used + len) + return -2; + font->get_metrics (font, in, from, to); + memcpy (out->glyphs + out->used, in->glyphs + from, + sizeof (MFLTGlyph) * len); + out->used += len; + return to; +} + +static MFLTGlyphString gstring; + +static int m17n_flt_initialized; + +extern Lisp_Object QCfamily; + +Lisp_Object +ftfont_shape_by_flt (lgstring, font, ft_face, otf) + Lisp_Object lgstring; + struct font *font; + FT_Face ft_face; + OTF *otf; +{ + EMACS_UINT len = LGSTRING_LENGTH (lgstring); + EMACS_UINT i; + struct MFLTFontFT flt_font_ft; + + if (! m17n_flt_initialized) + { + M17N_INIT (); + m17n_flt_initialized = 1; + } + + for (i = 0; i < len; i++) + if (NILP (LGSTRING_GLYPH (lgstring, i))) + break; + len = i; + + if (gstring.allocated == 0) + { + gstring.allocated = len * 2; + gstring.glyph_size = sizeof (MFLTGlyph); + gstring.glyphs = malloc (sizeof (MFLTGlyph) * gstring.allocated); + } + else if (gstring.allocated < len * 2) + { + gstring.allocated = len * 2; + gstring.glyphs = realloc (gstring.glyphs, + sizeof (MFLTGlyph) * gstring.allocated); + } + for (i = 0; i < len; i++) + gstring.glyphs[i].c = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, i)); + gstring.used = len; + gstring.r2l = 0; + + { + Lisp_Object family = Ffont_get (LGSTRING_FONT (lgstring), QCfamily); + + if (NILP (family)) + flt_font_ft.flt_font.family = Mnil; + else + flt_font_ft.flt_font.family = msymbol (SDATA (SYMBOL_NAME (family))); + } + flt_font_ft.flt_font.x_ppem = ft_face->size->metrics.x_ppem; + flt_font_ft.flt_font.y_ppem = ft_face->size->metrics.y_ppem; + flt_font_ft.flt_font.get_glyph_id = ftfont_get_glyph_id; + flt_font_ft.flt_font.get_metrics = ftfont_get_metrics; + flt_font_ft.flt_font.check_otf = ftfont_check_otf; + flt_font_ft.flt_font.drive_otf = ftfont_drive_otf; + flt_font_ft.flt_font.internal = NULL; + flt_font_ft.font = font; + flt_font_ft.ft_face = ft_face; + flt_font_ft.otf = otf; + for (i = 0; i < 3; i++) + { + int result = mflt_run (&gstring, 0, len, &flt_font_ft.flt_font, NULL); + if (result != -2) + break; + gstring.allocated += gstring.allocated; + gstring.glyphs = realloc (gstring.glyphs, + sizeof (MFLTGlyph) * gstring.allocated); + } + if (gstring.used > LGSTRING_LENGTH (lgstring)) + return Qnil; + for (i = 0; i < gstring.used; i++) + { + MFLTGlyph *g = gstring.glyphs + i; + + g->from = LGLYPH_FROM (LGSTRING_GLYPH (lgstring, g->from)); + g->to = LGLYPH_TO (LGSTRING_GLYPH (lgstring, g->to)); + } + + for (i = 0; i < gstring.used; i++) + { + Lisp_Object lglyph = LGSTRING_GLYPH (lgstring, i); + MFLTGlyph *g = gstring.glyphs + i; + + if (NILP (lglyph)) + { + lglyph = Fmake_vector (make_number (LGLYPH_SIZE), Qnil); + LGSTRING_SET_GLYPH (lgstring, i, lglyph); + } + LGLYPH_SET_FROM (lglyph, g->from); + LGLYPH_SET_TO (lglyph, g->to); + LGLYPH_SET_CHAR (lglyph, g->c); + LGLYPH_SET_CODE (lglyph, g->code); + LGLYPH_SET_WIDTH (lglyph, g->xadv >> 6); + LGLYPH_SET_LBEARING (lglyph, g->lbearing >> 6); + LGLYPH_SET_RBEARING (lglyph, g->rbearing >> 6); + LGLYPH_SET_ASCENT (lglyph, g->ascent >> 6); + LGLYPH_SET_DESCENT (lglyph, g->descent >> 6); + if (g->adjusted) + { + Lisp_Object vec; + + vec = Fmake_vector (make_number (3), Qnil); + ASET (vec, 0, make_number (g->xoff >> 6)); + ASET (vec, 1, make_number (g->yoff >> 6)); + ASET (vec, 2, make_number (g->xadv >> 6)); + LGLYPH_SET_ADJUSTMENT (lglyph, vec); + } + } + return make_number (i); +} + +Lisp_Object +ftfont_shape (lgstring) + Lisp_Object lgstring; +{ + struct font *font; + struct ftfont_info *ftfont_info; + + CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring), font); + ftfont_info = (struct ftfont_info *) font; + if (! ftfont_info->maybe_otf) + return 0; + if (! ftfont_info->otf) + { + OTF *otf = OTF_open_ft_face (ftfont_info->ft_size->face); + + if (! otf || OTF_get_table (otf, "head") < 0) + { + if (otf) + OTF_close (otf); + ftfont_info->maybe_otf = 0; + return 0; + } + + ftfont_info->otf = otf; + } + + return ftfont_shape_by_flt (lgstring, font, ftfont_info->ft_size->face, + ftfont_info->otf); +} + +#endif /* HAVE_M17N_FLT */ +#endif /* HAVE_LIBOTF */ + +Lisp_Object +ftfont_font_format (FcPattern *pattern) +{ + FcChar8 *str; + +#ifdef FC_FONTFORMAT + if (FcPatternGetString (pattern, FC_FONTFORMAT, 0, &str) != FcResultMatch) + return Qnil; + if (strcmp ((char *) str, "TrueType") == 0) + return intern ("truetype"); + if (strcmp ((char *) str, "Type 1") == 0) + return intern ("type1"); + if (strcmp ((char *) str, "PCF") == 0) + return intern ("pcf"); + if (strcmp ((char *) str, "BDF") == 0) + return intern ("bdf"); +#else /* not FC_FONTFORMAT */ + if (FcPatternGetString (pattern, FC_FILE, 0, &str) != FcResultMatch) + return Qnil; + if (strcasestr ((char *) str, ".ttf") == 0) + return intern ("truetype"); + if (strcasestr ((char *) str, "pfb") == 0) + return intern ("type1"); + if (strcasestr ((char *) str, "pcf") == 0) + return intern ("pcf"); + if (strcasestr ((char *) str, "bdf") == 0) + return intern ("bdf"); +#endif /* not FC_FONTFORMAT */ + return intern ("unknown"); +} + + +void +syms_of_ftfont () +{ + DEFSYM (Qfreetype, "freetype"); + DEFSYM (Qmonospace, "monospace"); + DEFSYM (Qsans_serif, "sans-serif"); + DEFSYM (Qserif, "serif"); + DEFSYM (Qmono, "mono"); + DEFSYM (Qsans, "sans"); + DEFSYM (Qsans__serif, "sans serif"); + + staticpro (&freetype_font_cache); + freetype_font_cache = Fcons (Qt, Qnil); + + staticpro (&ftfont_generic_family_list); + ftfont_generic_family_list + = Fcons (Fcons (Qmonospace, Qt), + Fcons (Fcons (Qsans_serif, Qt), + Fcons (Fcons (Qsans, Qt), Qnil))); + + ftfont_driver.type = Qfreetype; + register_font_driver (&ftfont_driver, NULL); +} + +/* arch-tag: 7cfa432c-33a6-4988-83d2-a82ed8604aca + (do not change this comment) */ diff --git a/src/ftfont.h b/src/ftfont.h new file mode 100644 index 00000000000..bd6d4780186 --- /dev/null +++ b/src/ftfont.h @@ -0,0 +1,42 @@ +/* ftfont.h -- Interface definition for Freetype font backend. + Copyright (C) 2007 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#ifndef EMACS_FTFONT_H +#define EMACS_FTFONT_H + +#include <ft2build.h> +#include FT_FREETYPE_H +#include FT_SIZES_H + +#ifdef HAVE_LIBOTF +#include <otf.h> +#ifdef HAVE_M17N_FLT +#include <m17n-flt.h> +extern Lisp_Object ftfont_shape_by_flt P_ ((Lisp_Object, struct font *, + FT_Face, OTF *)); +#endif /* HAVE_LIBOTF */ +#endif /* HAVE_M17N_FLT */ + +#endif /* EMACS_FTFONT_H */ + +/* arch-tag: cec13d1c-7156-4997-9ebd-e989040c3d78 + (do not change this comment) */ diff --git a/src/ftxfont.c b/src/ftxfont.c new file mode 100644 index 00000000000..62453a1df1b --- /dev/null +++ b/src/ftxfont.c @@ -0,0 +1,472 @@ +/* ftxfont.c -- FreeType font driver on X (without using XFT). + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> +#include <X11/Xlib.h> + +#include "lisp.h" +#include "dispextern.h" +#include "xterm.h" +#include "frame.h" +#include "blockinput.h" +#include "character.h" +#include "charset.h" +#include "fontset.h" +#include "font.h" + +/* FTX font driver. */ + +static Lisp_Object Qftx; + +/* Prototypes for helper function. */ +static GC *ftxfont_get_gcs P_ ((FRAME_PTR, unsigned long, unsigned long)); +static int ftxfont_draw_bitmap P_ ((FRAME_PTR, GC, GC *, struct font *, + unsigned, int, int, XPoint *, int, int *, + int)); +static void ftxfont_draw_backgrond P_ ((FRAME_PTR, struct font *, GC, + int, int, int)); +static Font ftxfont_default_fid P_ ((FRAME_PTR)); + +struct ftxfont_frame_data +{ + /* Background and foreground colors. */ + XColor colors[2]; + /* GCs interporationg the above colors. gcs[0] is for a color + closest to BACKGROUND, and gcs[5] is for a color closest to + FOREGROUND. */ + GC gcs[6]; + struct ftxfont_frame_data *next; +}; + + +/* Return an array of 6 GCs for antialiasing. */ + +static GC * +ftxfont_get_gcs (f, foreground, background) + FRAME_PTR f; + unsigned long foreground, background; +{ + XColor color; + XGCValues xgcv; + int i; + struct ftxfont_frame_data *data = font_get_frame_data (f, &ftxfont_driver); + struct ftxfont_frame_data *prev = NULL, *this = NULL, *new; + + if (data) + { + for (this = data; this; prev = this, this = this->next) + { + if (this->colors[0].pixel < background) + continue; + if (this->colors[0].pixel > background) + break; + if (this->colors[1].pixel < foreground) + continue; + if (this->colors[1].pixel > foreground) + break; + return this->gcs; + } + } + + new = malloc (sizeof (struct ftxfont_frame_data)); + if (! new) + return NULL; + new->next = this; + if (prev) + { + prev->next = new; + } + else if (font_put_frame_data (f, &ftxfont_driver, new) < 0) + { + free (new); + return NULL; + } + + new->colors[0].pixel = background; + new->colors[1].pixel = foreground; + + BLOCK_INPUT; + XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), new->colors, 2); + for (i = 1; i < 7; i++) + { + /* Interpolate colors linearly. Any better algorithm? */ + color.red + = (new->colors[1].red * i + new->colors[0].red * (8 - i)) / 8; + color.green + = (new->colors[1].green * i + new->colors[0].green * (8 - i)) / 8; + color.blue + = (new->colors[1].blue * i + new->colors[0].blue * (8 - i)) / 8; + if (! x_alloc_nearest_color (f, FRAME_X_COLORMAP (f), &color)) + break; + xgcv.foreground = color.pixel; + new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + GCForeground, &xgcv); + } + UNBLOCK_INPUT; + + if (i < 7) + { + BLOCK_INPUT; + for (i--; i >= 0; i--) + XFreeGC (FRAME_X_DISPLAY (f), new->gcs[i]); + UNBLOCK_INPUT; + if (prev) + prev->next = new->next; + else if (data) + font_put_frame_data (f, &ftxfont_driver, new->next); + free (new); + return NULL; + } + return new->gcs; +} + +static int +ftxfont_draw_bitmap (f, gc_fore, gcs, font, code, x, y, p, size, n, flush) + FRAME_PTR f; + GC gc_fore, *gcs; + struct font *font; + unsigned code; + int x, y; + XPoint *p; + int size, *n; + int flush; +{ + struct font_bitmap bitmap; + unsigned char *b; + int i, j; + + if (ftfont_driver.get_bitmap (font, code, &bitmap, size > 0x100 ? 1 : 8) < 0) + return 0; + if (size > 0x100) + { + for (i = 0, b = bitmap.buffer; i < bitmap.rows; + i++, b += bitmap.pitch) + { + for (j = 0; j < bitmap.width; j++) + if (b[j / 8] & (1 << (7 - (j % 8)))) + { + p[n[0]].x = x + bitmap.left + j; + p[n[0]].y = y - bitmap.top + i; + if (++n[0] == size) + { + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + gc_fore, p, size, CoordModeOrigin); + n[0] = 0; + } + } + } + if (flush && n[0] > 0) + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + gc_fore, p, n[0], CoordModeOrigin); + } + else + { + for (i = 0, b = bitmap.buffer; i < bitmap.rows; + i++, b += bitmap.pitch) + { + for (j = 0; j < bitmap.width; j++) + { + int idx = (bitmap.bits_per_pixel == 1 + ? ((b[j / 8] & (1 << (7 - (j % 8)))) ? 6 : -1) + : (b[j] >> 5) - 1); + + if (idx >= 0) + { + XPoint *pp = p + size * idx; + + pp[n[idx]].x = x + bitmap.left + j; + pp[n[idx]].y = y - bitmap.top + i; + if (++(n[idx]) == size) + { + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + idx == 6 ? gc_fore : gcs[idx], pp, size, + CoordModeOrigin); + n[idx] = 0; + } + } + } + } + if (flush) + { + for (i = 0; i < 6; i++) + if (n[i] > 0) + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + gcs[i], p + 0x100 * i, n[i], CoordModeOrigin); + if (n[6] > 0) + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + gc_fore, p + 0x600, n[6], CoordModeOrigin); + } + } + + if (ftfont_driver.free_bitmap) + ftfont_driver.free_bitmap (font, &bitmap); + + return bitmap.advance; +} + +static void +ftxfont_draw_backgrond (f, font, gc, x, y, width) + FRAME_PTR f; + struct font *font; + GC gc; + int x, y, width; +{ + XGCValues xgcv; + + XGetGCValues (FRAME_X_DISPLAY (f), gc, + GCForeground | GCBackground, &xgcv); + XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.background); + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + x, y - font->ascent, width, y + font->descent); + XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground); +} + +/* Return the default Font ID on frame F. */ + +static Font +ftxfont_default_fid (f) + FRAME_PTR f; +{ + static int fid_known; + static Font fid; + + if (! fid_known) + { + fid = XLoadFont (FRAME_X_DISPLAY (f), "fixed"); + if (! fid) + { + fid = XLoadFont (FRAME_X_DISPLAY (f), "*"); + if (! fid) + abort (); + } + fid_known = 1; + } + return fid; +} + +/* Prototypes for font-driver methods. */ +static Lisp_Object ftxfont_list P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object ftxfont_match P_ ((Lisp_Object, Lisp_Object)); +static struct font *ftxfont_open P_ ((FRAME_PTR, Lisp_Object, int)); +static void ftxfont_close P_ ((FRAME_PTR, struct font *)); +static int ftxfont_draw P_ ((struct glyph_string *, int, int, int, int, int)); + +struct font_driver ftxfont_driver; + +static Lisp_Object +ftxfont_list (frame, spec) + Lisp_Object frame; + Lisp_Object spec; +{ + Lisp_Object val = ftfont_driver.list (frame, spec); + + if (! NILP (val)) + { + int i; + + for (i = 0; i < ASIZE (val); i++) + ASET (AREF (val, i), FONT_TYPE_INDEX, Qftx); + } + return val; +} + +static Lisp_Object +ftxfont_match (frame, spec) + Lisp_Object frame; + Lisp_Object spec; +{ + Lisp_Object entity = ftfont_driver.match (frame, spec); + + if (VECTORP (entity)) + ASET (entity, FONT_TYPE_INDEX, Qftx); + return entity; +} + +static struct font * +ftxfont_open (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + struct font *font; + XFontStruct *xfont = malloc (sizeof (XFontStruct)); + + if (! xfont) + return NULL; + font = ftfont_driver.open (f, entity, pixel_size); + if (! font) + { + free (xfont); + return NULL; + } + + xfont->fid = ftxfont_default_fid (f); + xfont->ascent = font->ascent; + xfont->descent = font->descent; + xfont->max_bounds.width = font->font.size; + xfont->min_bounds.width = font->min_width; + font->font.font = xfont; + font->driver = &ftxfont_driver; + + dpyinfo->n_fonts++; + + /* Set global flag fonts_changed_p to non-zero if the font loaded + has a character with a smaller width than any other character + before, or if the font loaded has a smaller height than any other + font loaded before. If this happens, it will make a glyph matrix + reallocation necessary. */ + if (dpyinfo->n_fonts == 1) + { + dpyinfo->smallest_font_height = font->font.height; + dpyinfo->smallest_char_width = font->min_width; + fonts_changed_p = 1; + } + else + { + if (dpyinfo->smallest_font_height > font->font.height) + dpyinfo->smallest_font_height = font->font.height, fonts_changed_p |= 1; + if (dpyinfo->smallest_char_width > font->min_width) + dpyinfo->smallest_char_width = font->min_width, fonts_changed_p |= 1; + } + + return font; +} + +static void +ftxfont_close (f, font) + FRAME_PTR f; + struct font *font; +{ + ftfont_driver.close (f, font); + FRAME_X_DISPLAY_INFO (f)->n_fonts--; +} + +static int +ftxfont_draw (s, from, to, x, y, with_background) + struct glyph_string *s; + int from, to, x, y, with_background; +{ + FRAME_PTR f = s->f; + struct face *face = s->face; + struct font *font = (struct font *) face->font_info; + XPoint p[0x700]; + int n[7]; + unsigned *code; + int len = to - from; + int i; + GC *gcs; + + n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0; + + BLOCK_INPUT; + if (with_background) + ftxfont_draw_backgrond (f, font, s->gc, x, y, s->width); + code = alloca (sizeof (unsigned) * len); + for (i = 0; i < len; i++) + code[i] = ((XCHAR2B_BYTE1 (s->char2b + from + i) << 8) + | XCHAR2B_BYTE2 (s->char2b + from + i)); + + if (face->gc == s->gc) + { + gcs = ftxfont_get_gcs (f, face->foreground, face->background); + } + else + { + XGCValues xgcv; + unsigned long mask = GCForeground | GCBackground; + + XGetGCValues (FRAME_X_DISPLAY (f), s->gc, mask, &xgcv); + gcs = ftxfont_get_gcs (f, xgcv.foreground, xgcv.background); + } + + if (gcs) + { + if (s->num_clips) + for (i = 0; i < 6; i++) + XSetClipRectangles (FRAME_X_DISPLAY (f), gcs[i], 0, 0, + s->clip, s->num_clips, Unsorted); + + for (i = 0; i < len; i++) + x += ftxfont_draw_bitmap (f, s->gc, gcs, font, code[i], x, y, + p, 0x100, n, i + 1 == len); + if (s->num_clips) + for (i = 0; i < 6; i++) + XSetClipMask (FRAME_X_DISPLAY (f), gcs[i], None); + } + else + { + /* We can't draw with antialiasing. + s->gc should already have a proper clipping setting. */ + for (i = 0; i < len; i++) + x += ftxfont_draw_bitmap (f, s->gc, NULL, font, code[i], x, y, + p, 0x700, n, i + 1 == len); + } + + UNBLOCK_INPUT; + + return len; +} + +static int +ftxfont_end_for_frame (f) + FRAME_PTR f; +{ + struct ftxfont_frame_data *data = font_get_frame_data (f, &ftxfont_driver); + + BLOCK_INPUT; + while (data) + { + struct ftxfont_frame_data *next = data->next; + int i; + + for (i = 0; i < 6; i++) + XFreeGC (FRAME_X_DISPLAY (f), data->gcs[i]); + free (data); + data = next; + } + UNBLOCK_INPUT; + return 0; +} + + + +void +syms_of_ftxfont () +{ + DEFSYM (Qftx, "ftx"); + + ftxfont_driver = ftfont_driver; + ftxfont_driver.type = Qftx; + ftxfont_driver.list = ftxfont_list; + ftxfont_driver.match = ftxfont_match; + ftxfont_driver.open = ftxfont_open; + ftxfont_driver.close = ftxfont_close; + ftxfont_driver.draw = ftxfont_draw; + ftxfont_driver.end_for_frame = ftxfont_end_for_frame; + register_font_driver (&ftxfont_driver, NULL); +} + +/* arch-tag: 59bd3469-5330-413f-b29d-1aa36492abe8 + (do not change this comment) */ diff --git a/src/indent.c b/src/indent.c index 2d48dc746d7..3f528749570 100644 --- a/src/indent.c +++ b/src/indent.c @@ -24,7 +24,7 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "category.h" #include "indent.h" #include "keyboard.h" @@ -291,7 +291,7 @@ check_composition (pos, pos_byte, point, len, len_byte, width) int *len, *len_byte, *width; { Lisp_Object prop; - int start, end; + EMACS_INT start, end; int id; if (! find_composition (pos, -1, &start, &end, &prop, Qnil) @@ -327,7 +327,7 @@ check_composition (pos, pos_byte, point, len, len_byte, width) if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) \ width = XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; \ else \ - width = WIDTH_BY_CHAR_HEAD (*p); \ + width = CHAR_WIDTH (c); \ if (width > 1) \ wide_column = width; \ } \ diff --git a/src/insdel.c b/src/insdel.c index 5cde53864b7..0b10534db2f 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -24,7 +24,7 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "intervals.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "window.h" #include "blockinput.h" #include "region-cache.h" @@ -652,22 +652,11 @@ copy_text (from_addr, to_addr, nbytes, int bytes_left = nbytes; Lisp_Object tbl = Qnil; - /* We set the variable tbl to the reverse table of - Vnonascii_translation_table in advance. */ - if (CHAR_TABLE_P (Vnonascii_translation_table)) - { - tbl = Fchar_table_extra_slot (Vnonascii_translation_table, - make_number (0)); - if (!CHAR_TABLE_P (tbl)) - tbl = Qnil; - } - - /* Convert multibyte to single byte. */ while (bytes_left > 0) { int thislen, c; c = STRING_CHAR_AND_LENGTH (from_addr, bytes_left, thislen); - if (!SINGLE_BYTE_CHAR_P (c)) + if (!ASCII_CHAR_P (c)) c = multibyte_char_to_unibyte (c, tbl); *to_addr++ = c; from_addr += thislen; @@ -1173,6 +1162,50 @@ insert_from_string_1 (string, pos, pos_byte, nchars, nbytes, current_buffer, inherit); adjust_point (nchars, outgoing_nbytes); + + CHECK_MARKERS (); +} + +/* Insert a sequence of NCHARS chars which occupy NBYTES bytes + starting at GPT_ADDR. */ + +void +insert_from_gap (nchars, nbytes) + register int nchars, nbytes; +{ + if (NILP (current_buffer->enable_multibyte_characters)) + nchars = nbytes; + + record_insert (GPT, nchars); + MODIFF++; + + GAP_SIZE -= nbytes; + GPT += nchars; + ZV += nchars; + Z += nchars; + GPT_BYTE += nbytes; + ZV_BYTE += nbytes; + Z_BYTE += nbytes; + if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */ + + if (GPT_BYTE < GPT) + abort (); + + adjust_overlays_for_insert (GPT - nchars, nchars); + adjust_markers_for_insert (GPT - nchars, GPT_BYTE - nbytes, + GPT, GPT_BYTE, 0); + + if (BUF_INTERVALS (current_buffer) != 0) + { + offset_intervals (current_buffer, GPT - nchars, nchars); + graft_intervals_into_buffer (NULL_INTERVAL, GPT - nchars, nchars, + current_buffer, 0); + } + + if (GPT - nchars < PT) + adjust_point (nchars, nbytes); + + CHECK_MARKERS (); } /* Insert text from BUF, NCHARS characters starting at CHARPOS, into the diff --git a/src/intervals.c b/src/intervals.c index 639abcf3491..1190ad11cea 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -2316,7 +2316,7 @@ int get_property_and_range (pos, prop, val, start, end, object) int pos; Lisp_Object prop, *val; - int *start, *end; + EMACS_INT *start, *end; Lisp_Object object; { INTERVAL i, prev, next; diff --git a/src/intervals.h b/src/intervals.h index 3b746ec40e9..d15470521da 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -300,7 +300,7 @@ extern Lisp_Object textget P_ ((Lisp_Object, Lisp_Object)); extern Lisp_Object lookup_char_property P_ ((Lisp_Object, Lisp_Object, int)); extern void move_if_not_intangible P_ ((int)); extern int get_property_and_range P_ ((int, Lisp_Object, Lisp_Object *, - int *, int *, Lisp_Object)); + EMACS_INT *, EMACS_INT *, Lisp_Object)); extern Lisp_Object get_local_map P_ ((int, struct buffer *, Lisp_Object)); extern INTERVAL update_interval P_ ((INTERVAL, int)); extern void set_intervals_multibyte P_ ((int)); diff --git a/src/keyboard.c b/src/keyboard.c index bcd3b536c57..2230b339f5e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -33,7 +33,7 @@ Boston, MA 02110-1301, USA. */ #include "window.h" #include "commands.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "disptab.h" #include "dispextern.h" #include "syntax.h" @@ -1799,7 +1799,7 @@ command_loop_1 () : (lose >= 0x20 && lose < 0x7f)) /* To extract the case of continuation on wide-column characters. */ - && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1) + && ASCII_BYTE_P (lose) && (XFASTINT (XWINDOW (selected_window)->last_modified) >= MODIFF) && (XFASTINT (XWINDOW (selected_window)->last_overlay_modified) @@ -1856,7 +1856,7 @@ command_loop_1 () { unsigned int c = translate_char (Vtranslation_table_for_input, - XFASTINT (last_command_char), 0, 0, 0); + XFASTINT (last_command_char)); int value; if (NILP (Vexecuting_kbd_macro) && !EQ (minibuf_window, selected_window)) @@ -2035,7 +2035,7 @@ adjust_point_for_property (last_pt, modified) int last_pt; int modified; { - int beg, end; + EMACS_INT beg, end; Lisp_Object val, overlay, tmp; int check_composition = 1, check_display = 1, check_invisible = 1; int orig_pt = PT; @@ -3196,7 +3196,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu, end_time) || (VECTORP (current_kboard->Vkeyboard_translate_table) && XVECTOR (current_kboard->Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c)) || (CHAR_TABLE_P (current_kboard->Vkeyboard_translate_table) - && CHAR_VALID_P (XINT (c), 0))) + && CHARACTERP (c))) { Lisp_Object d; d = Faref (current_kboard->Vkeyboard_translate_table, c); @@ -10087,8 +10087,38 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, /* If KEY is not defined in any of the keymaps, and cannot be part of a function key or translation, - and is an upper case letter or shifted key, - use the corresponding lower-case/unshifted key instead. */ + and is an upper case letter + use the corresponding lower-case letter instead. */ + if (first_binding >= nmaps + && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t + && INTEGERP (key) + && ((CHARACTERP (make_number (XINT (key) & ~CHAR_MODIFIER_MASK)) + && UPPERCASEP (XINT (key) & ~CHAR_MODIFIER_MASK)) + || (XINT (key) & shift_modifier))) + { + Lisp_Object new_key; + + original_uppercase = key; + original_uppercase_position = t - 1; + + if (XINT (key) & shift_modifier) + XSETINT (new_key, XINT (key) & ~shift_modifier); + else + XSETINT (new_key, (DOWNCASE (XINT (key) & ~CHAR_MODIFIER_MASK) + | (XINT (key) & ~CHAR_MODIFIER_MASK))); + + /* We have to do this unconditionally, regardless of whether + the lower-case char is defined in the keymaps, because they + might get translated through function-key-map. */ + keybuf[t - 1] = new_key; + mock_input = max (t, mock_input); + + goto replay_sequence; + } + /* If KEY is not defined in any of the keymaps, + and cannot be part of a function key or translation, + and is a shifted function key, + use the corresponding unshifted function key instead. */ if (first_binding >= nmaps && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t) { diff --git a/src/keymap.c b/src/keymap.c index 5cfa8e7e1ce..1630ac22a53 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -29,6 +29,7 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "commands.h" #include "buffer.h" +#include "character.h" #include "charset.h" #include "keyboard.h" #include "frame.h" @@ -422,11 +423,7 @@ Return PARENT. PARENT should be nil or another keymap. */) if (CHAR_TABLE_P (XCAR (list))) { - int indices[3]; - - map_char_table (fix_submap_inheritance, Qnil, - XCAR (list), XCAR (list), - keymap, 0, indices); + map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap); } } @@ -566,9 +563,7 @@ access_keymap (map, idx, t_ok, noinherit, autoload) GCPRO4 (map, tail, idx, t_binding); - /* If `t_ok' is 2, both `t' and generic-char bindings are accepted. - If it is 1, only generic-char bindings are accepted. - Otherwise, neither are. */ + /* If `t_ok' is 2, both `t' is accepted. */ t_ok = t_ok ? 2 : 0; for (tail = XCDR (map); @@ -592,24 +587,6 @@ access_keymap (map, idx, t_ok, noinherit, autoload) if (EQ (key, idx)) val = XCDR (binding); - else if (t_ok - && INTEGERP (idx) - && (XINT (idx) & CHAR_MODIFIER_MASK) == 0 - && INTEGERP (key) - && (XINT (key) & CHAR_MODIFIER_MASK) == 0 - && !SINGLE_BYTE_CHAR_P (XINT (idx)) - && !SINGLE_BYTE_CHAR_P (XINT (key)) - && CHAR_VALID_P (XINT (key), 1) - && !CHAR_VALID_P (XINT (key), 0) - && (CHAR_CHARSET (XINT (key)) - == CHAR_CHARSET (XINT (idx)))) - { - /* KEY is the generic character of the charset of IDX. - Use KEY's binding if there isn't a binding for IDX - itself. */ - t_binding = XCDR (binding); - t_ok = 0; - } else if (t_ok > 1 && EQ (key, Qt)) { t_binding = XCDR (binding); @@ -721,12 +698,10 @@ map_keymap (map, fun, args, data, autoload) } else if (CHAR_TABLE_P (binding)) { - int indices[3]; - map_char_table (map_keymap_char_table_item, Qnil, binding, binding, + map_char_table (map_keymap_char_table_item, Qnil, binding, Fcons (make_save_value (fun, 0), Fcons (make_save_value (data, 0), - args)), - 0, indices); + args))); } } UNGCPRO; @@ -881,10 +856,15 @@ store_in_keymap (keymap, idx, def) if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap)) error ("attempt to define a key in a non-keymap"); - /* If idx is a list (some sort of mouse click, perhaps?), - the index we want to use is the car of the list, which - ought to be a symbol. */ - idx = EVENT_HEAD (idx); + /* If idx is a cons, and the car part is a character, idx must be of + the form (FROM-CHAR . TO-CHAR). */ + if (CONSP (idx) && CHARACTERP (XCAR (idx))) + CHECK_CHARACTER_CDR (idx); + else + /* If idx is a list (some sort of mouse click, perhaps?), + the index we want to use is the car of the list, which + ought to be a symbol. */ + idx = EVENT_HEAD (idx); /* If idx is a symbol, it might have modifiers, which need to be put in the canonical order. */ @@ -921,6 +901,19 @@ store_in_keymap (keymap, idx, def) ASET (elt, XFASTINT (idx), def); return def; } + else if (CONSP (idx) && CHARACTERP (XCAR (idx))) + { + int from = XFASTINT (XCAR (idx)); + int to = XFASTINT (XCDR (idx)); + + if (to >= ASIZE (elt)) + to = ASIZE (elt) - 1; + for (; from <= to; from++) + ASET (elt, from, def); + if (to == XFASTINT (XCDR (idx))) + /* We have defined all keys in IDX. */ + return def; + } insertion_point = tail; } else if (CHAR_TABLE_P (elt)) @@ -937,6 +930,11 @@ store_in_keymap (keymap, idx, def) NILP (def) ? Qt : def); return def; } + else if (CONSP (idx) && CHARACTERP (XCAR (idx))) + { + Fset_char_table_range (elt, idx, NILP (def) ? Qt : def); + return def; + } insertion_point = tail; } else if (CONSP (elt)) @@ -947,6 +945,19 @@ store_in_keymap (keymap, idx, def) XSETCDR (elt, def); return def; } + else if (CONSP (idx) && CHARACTERP (XCAR (idx))) + { + int from = XFASTINT (XCAR (idx)); + int to = XFASTINT (XCDR (idx)); + + if (from <= XFASTINT (XCAR (elt)) + && to >= XFASTINT (XCAR (elt))) + { + XSETCDR (elt, def); + if (from == to) + return def; + } + } } else if (EQ (elt, Qkeymap)) /* If we find a 'keymap' symbol in the spine of KEYMAP, @@ -961,9 +972,22 @@ store_in_keymap (keymap, idx, def) keymap_end: /* We have scanned the entire keymap, and not found a binding for IDX. Let's add one. */ - CHECK_IMPURE (insertion_point); - XSETCDR (insertion_point, - Fcons (Fcons (idx, def), XCDR (insertion_point))); + { + Lisp_Object elt; + + if (CONSP (idx) && CHARACTERP (XCAR (idx))) + { + /* IDX specifies a range of characters, and not all of them + were handled yet, which means this keymap doesn't have a + char-table. So, we insert a char-table now. */ + elt = Fmake_char_table (Qkeymap, Qnil); + Fset_char_table_range (elt, idx, NILP (def) ? Qt : def); + } + else + elt = Fcons (idx, def); + CHECK_IMPURE (insertion_point); + XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point))); + } } return def; @@ -1049,7 +1073,7 @@ static void copy_keymap_1 (chartable, idx, elt) Lisp_Object chartable, idx, elt; { - Faset (chartable, idx, copy_keymap_item (elt)); + Fset_char_table_range (chartable, idx, copy_keymap_item (elt)); } DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0, @@ -1072,9 +1096,8 @@ is not copied. */) Lisp_Object elt = XCAR (keymap); if (CHAR_TABLE_P (elt)) { - int indices[3]; elt = Fcopy_sequence (elt); - map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices); + map_char_table (copy_keymap_1, Qnil, elt, elt); } else if (VECTORP (elt)) { @@ -1171,8 +1194,15 @@ binding KEY to DEF is added at the front of KEYMAP. */) { c = Faref (key, make_number (idx)); - if (CONSP (c) && lucid_event_type_list_p (c)) - c = Fevent_convert_list (c); + if (CONSP (c)) + { + /* C may be a Lucid style event type list or a cons (FROM . + TO) specifying a range of characters. */ + if (lucid_event_type_list_p (c)) + c = Fevent_convert_list (c); + else if (CHARACTERP (XCAR (c))) + CHECK_CHARACTER_CDR (c); + } if (SYMBOLP (c)) silly_event_symbol_error (c); @@ -1193,7 +1223,10 @@ binding KEY to DEF is added at the front of KEYMAP. */) idx++; } - if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c)) + if (!INTEGERP (c) && !SYMBOLP (c) + && (!CONSP (c) + /* If C is a range, it must be a leaf. */ + || (INTEGERP (XCAR (c)) && idx != length))) error ("Key sequence contains invalid event"); if (idx == length) @@ -2314,15 +2347,13 @@ push_key_description (c, p, force_multibyte) int force_multibyte; { unsigned c2; - int valid_p; /* Clear all the meaningless bits above the meta bit. */ c &= meta_modifier | ~ - meta_modifier; c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier | meta_modifier | shift_modifier | super_modifier); - valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0); - if (! valid_p) + if (! CHARACTERP (make_number (c2))) { /* KEY_DESCRIPTION_SIZE is large enough for this. */ p += sprintf (p, "[%d]", c); @@ -2416,25 +2447,12 @@ push_key_description (c, p, force_multibyte) } else { - if (force_multibyte) - { - if (SINGLE_BYTE_CHAR_P (c)) - c = unibyte_char_to_multibyte (c); - p += CHAR_STRING (c, p); - } - else if (NILP (current_buffer->enable_multibyte_characters)) - { - int bit_offset; - *p++ = '\\'; - /* The biggest character code uses 19 bits. */ - for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3) - { - if (c >= (1 << bit_offset)) - *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0'; - } - } + /* Now we are sure that C is a valid character code. */ + if (NILP (current_buffer->enable_multibyte_characters) + && ! force_multibyte) + *p++ = multibyte_char_to_unibyte (c, Qnil); else - p += CHAR_STRING (c, p); + p += CHAR_STRING (c, (unsigned char *) p); } return p; @@ -2458,56 +2476,10 @@ around function keys and event symbols. */) if (INTEGERP (key)) /* Normal character */ { - unsigned int charset, c1, c2; - int without_bits = XINT (key) & ~((-1) << CHARACTERBITS); - - if (SINGLE_BYTE_CHAR_P (without_bits)) - charset = 0; - else - SPLIT_CHAR (without_bits, charset, c1, c2); - - if (! CHAR_VALID_P (without_bits, 1)) - { - char buf[256]; + char tem[KEY_DESCRIPTION_SIZE]; - sprintf (buf, "Invalid char code %ld", (long) XINT (key)); - return build_string (buf); - } - else if (charset - && ((c1 == 0 && c2 == -1) || c2 == 0)) - { - /* Handle a generic character. */ - Lisp_Object name; - char buf[256]; - - name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX); - CHECK_STRING (name); - if (c1 == 0) - /* Only a charset is specified. */ - sprintf (buf, "Generic char %d: all of ", without_bits); - else - /* 1st code-point of 2-dimensional charset is specified. */ - sprintf (buf, "Generic char %d: row %d of ", without_bits, c1); - return concat2 (build_string (buf), name); - } - else - { - char tem[KEY_DESCRIPTION_SIZE], *end; - int nbytes, nchars; - Lisp_Object string; - - end = push_key_description (XUINT (key), tem, 1); - nbytes = end - tem; - nchars = multibyte_chars_in_text (tem, nbytes); - if (nchars == nbytes) - { - *end = '\0'; - string = build_string (tem); - } - else - string = make_multibyte_string (tem, nchars, nbytes); - return string; - } + *push_key_description (XUINT (key), tem, 1) = 0; + return build_string (tem); } else if (SYMBOLP (key)) /* Function key or event-symbol */ { @@ -2573,7 +2545,7 @@ See Info node `(elisp)Describing Characters' for examples. */) CHECK_NUMBER (character); c = XINT (character); - if (!SINGLE_BYTE_CHAR_P (c)) + if (!ASCII_CHAR_P (c)) { int len = CHAR_STRING (c, str); @@ -2952,7 +2924,11 @@ where_is_internal_1 (key, binding, args, data) Faset (sequence, last, make_number (XINT (key) | meta_modifier)); } else - sequence = append_key (this, key); + { + if (CONSP (key)) + key = Fcons (XCAR (key), XCDR (key)); + sequence = append_key (this, key); + } if (!NILP (where_is_cache)) { @@ -3608,9 +3584,10 @@ DESCRIBER is the output function used; nil means use `princ'. */) If the definition in effect in the whole map does not match the one in this vector, we ignore this one. - When describing a sub-char-table, INDICES is a list of - indices at higher levels in this char-table, - and CHAR_TABLE_DEPTH says how many levels down we have gone. + ARGS is simply passed as the second argument to ELT_DESCRIBER. + + INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in + the near future. KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-. @@ -3635,24 +3612,18 @@ describe_vector (vector, prefix, args, elt_describer, Lisp_Object definition; Lisp_Object tem2; Lisp_Object elt_prefix = Qnil; - register int i; + int i; Lisp_Object suppress; Lisp_Object kludge; int first = 1; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* Range of elements to be handled. */ int from, to; - /* A flag to tell if a leaf in this level of char-table is not a - generic character (i.e. a complete multibyte character). */ - int complete_char; - int character; + Lisp_Object character; int starting_i; suppress = Qnil; - if (indices == 0) - indices = (int *) alloca (3 * sizeof (int)); - definition = Qnil; if (!keymap_p) @@ -3676,61 +3647,24 @@ describe_vector (vector, prefix, args, elt_describer, if (partial) suppress = intern ("suppress-keymap"); - if (CHAR_TABLE_P (vector)) - { - if (char_table_depth == 0) - { - /* VECTOR is a top level char-table. */ - complete_char = 1; - from = 0; - to = CHAR_TABLE_ORDINARY_SLOTS; - } - else - { - /* VECTOR is a sub char-table. */ - if (char_table_depth >= 3) - /* A char-table is never that deep. */ - error ("Too deep char table"); - - complete_char - = (CHARSET_VALID_P (indices[0]) - && ((CHARSET_DIMENSION (indices[0]) == 1 - && char_table_depth == 1) - || char_table_depth == 2)); - - /* Meaningful elements are from 32th to 127th. */ - from = 32; - to = SUB_CHAR_TABLE_ORDINARY_SLOTS; - } - } - else - { - /* This does the right thing for ordinary vectors. */ - - complete_char = 1; - from = 0; - to = XVECTOR (vector)->size; - } + from = 0; + to = CHAR_TABLE_P (vector) ? MAX_CHAR + 1 : XVECTOR (vector)->size; for (i = from; i < to; i++) { int this_shadowed = 0; - QUIT; + int range_beg, range_end; + Lisp_Object val; - if (CHAR_TABLE_P (vector)) - { - if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS) - complete_char = 0; + QUIT; - if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS - && !CHARSET_DEFINED_P (i - 128)) - continue; + starting_i = i; - definition - = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0); - } + if (CHAR_TABLE_P (vector)) + val = char_table_ref_and_range (vector, i, &range_beg, &i); else - definition = get_keyelt (AREF (vector, i), 0); + val = AREF (vector, i); + definition = get_keyelt (val, 0); if (NILP (definition)) continue; @@ -3744,31 +3678,11 @@ describe_vector (vector, prefix, args, elt_describer, if (!NILP (tem)) continue; } - /* Set CHARACTER to the character this entry describes, if any. - Also update *INDICES. */ - if (CHAR_TABLE_P (vector)) - { - indices[char_table_depth] = i; - - if (char_table_depth == 0) - { - character = i; - indices[0] = i - 128; - } - else if (complete_char) - { - character = MAKE_CHAR (indices[0], indices[1], indices[2]); - } - else - character = 0; - } - else - character = i; - - ASET (kludge, 0, make_number (character)); + character = make_number (starting_i); + ASET (kludge, 0, character); /* If this binding is shadowed by some other map, ignore it. */ - if (!NILP (shadow) && complete_char) + if (!NILP (shadow)) { Lisp_Object tem; @@ -3785,7 +3699,7 @@ describe_vector (vector, prefix, args, elt_describer, /* Ignore this definition if it is shadowed by an earlier one in the same keymap. */ - if (!NILP (entire_map) && complete_char) + if (!NILP (entire_map)) { Lisp_Object tem; @@ -3797,89 +3711,28 @@ describe_vector (vector, prefix, args, elt_describer, if (first) { - if (char_table_depth == 0) - insert ("\n", 1); + insert ("\n", 1); first = 0; } - /* For a sub char-table, show the depth by indentation. - CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */ - if (char_table_depth > 0) - insert (" ", char_table_depth * 2); /* depth is 1 or 2. */ - /* Output the prefix that applies to every entry in this map. */ if (!NILP (elt_prefix)) insert1 (elt_prefix); - /* Insert or describe the character this slot is for, - or a description of what it is for. */ - if (SUB_CHAR_TABLE_P (vector)) - { - if (complete_char) - insert_char (character); - else - { - /* We need an octal representation for this block of - characters. */ - char work[16]; - sprintf (work, "(row %d)", i); - insert (work, strlen (work)); - } - } - else if (CHAR_TABLE_P (vector)) - { - if (complete_char) - insert1 (Fkey_description (kludge, prefix)); - else - { - /* Print the information for this character set. */ - insert_string ("<"); - tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX); - if (STRINGP (tem2)) - insert_from_string (tem2, 0, 0, SCHARS (tem2), - SBYTES (tem2), 0); - else - insert ("?", 1); - insert (">", 1); - } - } - else - { - insert1 (Fkey_description (kludge, prefix)); - } - - /* If we find a sub char-table within a char-table, - scan it recursively; it defines the details for - a character set or a portion of a character set. */ - if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition)) - { - insert ("\n", 1); - describe_vector (definition, prefix, args, elt_describer, - partial, shadow, entire_map, - indices, char_table_depth + 1, keymap_p, - mention_shadow); - continue; - } - - starting_i = i; + insert1 (Fkey_description (kludge, prefix)); /* Find all consecutive characters or rows that have the same definition. But, for elements of a top level char table, if they are for charsets, we had better describe one by one even if they have the same definition. */ if (CHAR_TABLE_P (vector)) - { - int limit = to; - - if (char_table_depth == 0) - limit = CHAR_TABLE_SINGLE_BYTE_SLOTS; - - while (i + 1 < limit - && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0), - !NILP (tem2)) - && !NILP (Fequal (tem2, definition))) - i++; - } + while (i + 1 < to + && (val = char_table_ref_and_range (vector, i + 1, + &range_beg, &range_end), + tem2 = get_keyelt (val, 0), + !NILP (tem2)) + && !NILP (Fequal (tem2, definition))) + i = range_end; else while (i + 1 < to && (tem2 = get_keyelt (AREF (vector, i + 1), 0), @@ -3887,7 +3740,6 @@ describe_vector (vector, prefix, args, elt_describer, && !NILP (Fequal (tem2, definition))) i++; - /* If we have a range of more than one character, print where the range reaches to. */ @@ -3900,31 +3752,7 @@ describe_vector (vector, prefix, args, elt_describer, if (!NILP (elt_prefix)) insert1 (elt_prefix); - if (CHAR_TABLE_P (vector)) - { - if (char_table_depth == 0) - { - insert1 (Fkey_description (kludge, prefix)); - } - else if (complete_char) - { - indices[char_table_depth] = i; - character = MAKE_CHAR (indices[0], indices[1], indices[2]); - insert_char (character); - } - else - { - /* We need an octal representation for this block of - characters. */ - char work[16]; - sprintf (work, "(row %d)", i); - insert (work, strlen (work)); - } - } - else - { - insert1 (Fkey_description (kludge, prefix)); - } + insert1 (Fkey_description (kludge, prefix)); } /* Print a description of the definition of this character. @@ -3940,11 +3768,11 @@ describe_vector (vector, prefix, args, elt_describer, } } - /* For (sub) char-table, print `defalt' slot at last. */ - if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt)) + if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt)) { - insert (" ", char_table_depth * 2); - insert_string ("<<default>>"); + if (!NILP (elt_prefix)) + insert1 (elt_prefix); + insert ("default", 7); (*elt_describer) (XCHAR_TABLE (vector)->defalt, args); } diff --git a/src/lisp.h b/src/lisp.h index ee51db1f425..fb53f68b073 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -348,8 +348,9 @@ enum pvec_type PVEC_BUFFER = 0x20000, PVEC_HASH_TABLE = 0x40000, PVEC_TERMINAL = 0x80000, - PVEC_OTHER = 0x100000, - PVEC_TYPE_MASK = 0x1ffe00 + PVEC_SUB_CHAR_TABLE = 0x100000, + PVEC_OTHER = 0x200000, + PVEC_TYPE_MASK = 0x2ffe00 #if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to GDB. It doesn't work on OS Alpha. Moved to a variable in @@ -475,17 +476,6 @@ extern Lisp_Object make_number P_ ((EMACS_INT)); #define EQ(x, y) (XHASH (x) == XHASH (y)) -/* During garbage collection, XGCTYPE must be used for extracting types - so that the mark bit is ignored. XMARKBIT accesses the markbit. - Markbits are used only in particular slots of particular structure types. - Other markbits are always zero. - Outside of garbage collection, all mark bits are always zero. */ - -#ifndef XGCTYPE -/* The distinction does not exist now that the MARKBIT has been eliminated. */ -#define XGCTYPE(a) XTYPE (a) -#endif - #ifndef XPNTR #ifdef HAVE_SHM /* In this representation, data is found in two widely separated segments. */ @@ -527,11 +517,11 @@ extern size_t pure_size; /* Extract a value or address from a Lisp_Object. */ -#define XCONS(a) (eassert (GC_CONSP(a)),(struct Lisp_Cons *) XPNTR(a)) -#define XVECTOR(a) (eassert (GC_VECTORLIKEP(a)),(struct Lisp_Vector *) XPNTR(a)) -#define XSTRING(a) (eassert (GC_STRINGP(a)),(struct Lisp_String *) XPNTR(a)) -#define XSYMBOL(a) (eassert (GC_SYMBOLP(a)),(struct Lisp_Symbol *) XPNTR(a)) -#define XFLOAT(a) (eassert (GC_FLOATP(a)),(struct Lisp_Float *) XPNTR(a)) +#define XCONS(a) (eassert (CONSP(a)),(struct Lisp_Cons *) XPNTR(a)) +#define XVECTOR(a) (eassert (VECTORLIKEP(a)),(struct Lisp_Vector *) XPNTR(a)) +#define XSTRING(a) (eassert (STRINGP(a)),(struct Lisp_String *) XPNTR(a)) +#define XSYMBOL(a) (eassert (SYMBOLP(a)),(struct Lisp_Symbol *) XPNTR(a)) +#define XFLOAT(a) (eassert (FLOATP(a)),(struct Lisp_Float *) XPNTR(a)) /* Misc types. */ @@ -553,13 +543,14 @@ extern size_t pure_size; /* Pseudovector types. */ -#define XPROCESS(a) (eassert (GC_PROCESSP(a)),(struct Lisp_Process *) XPNTR(a)) -#define XWINDOW(a) (eassert (GC_WINDOWP(a)),(struct window *) XPNTR(a)) -#define XTERMINAL(a) (eassert (GC_TERMINALP(a)),(struct terminal *) XPNTR(a)) -#define XSUBR(a) (eassert (GC_SUBRP(a)),(struct Lisp_Subr *) XPNTR(a)) -#define XBUFFER(a) (eassert (GC_BUFFERP(a)),(struct buffer *) XPNTR(a)) -#define XCHAR_TABLE(a) (eassert (GC_CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR(a)) -#define XBOOL_VECTOR(a) (eassert (GC_BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR(a)) +#define XPROCESS(a) (eassert (PROCESSP(a)),(struct Lisp_Process *) XPNTR(a)) +#define XWINDOW(a) (eassert (WINDOWP(a)),(struct window *) XPNTR(a)) +#define XTERMINAL(a) (eassert (TERMINALP(a)),(struct terminal *) XPNTR(a)) +#define XSUBR(a) (eassert (SUBRP(a)),(struct Lisp_Subr *) XPNTR(a)) +#define XBUFFER(a) (eassert (BUFFERP(a)),(struct buffer *) XPNTR(a)) +#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR(a)) +#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR(a)) +#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR(a)) /* Construct a Lisp_Object from a value or address. */ @@ -592,6 +583,7 @@ extern size_t pure_size; #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER)) #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE)) #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR)) +#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE)) /* Convenience macros for dealing with Lisp arrays. */ @@ -772,49 +764,20 @@ struct Lisp_Vector ((OFFSETOF(type, nonlispfield) - OFFSETOF(struct Lisp_Vector, contents[0])) \ / sizeof (Lisp_Object)) -/* A char table is a kind of vectorlike, with contents are like a +/* A char-table is a kind of vectorlike, with contents are like a vector but with a few other slots. For some purposes, it makes - sense to handle a chartable with type struct Lisp_Vector. An + sense to handle a char-table with type struct Lisp_Vector. An element of a char table can be any Lisp objects, but if it is a sub char-table, we treat it a table that contains information of a - group of characters of the same charsets or a specific character of - a charset. A sub char-table has the same structure as a char table - except for that the former omits several slots at the tail. A sub - char table appears only in an element of a char table, and there's - no way to access it directly from Emacs Lisp program. */ - -/* This is the number of slots that apply to characters or character - sets. The first 128 are for ASCII, the next 128 are for 8-bit - European characters, and the last 128 are for multibyte characters. - The first 256 are indexed by the code itself, but the last 128 are - indexed by (charset-id + 128). */ -#define CHAR_TABLE_ORDINARY_SLOTS 384 - -/* These are the slot of the default values for single byte - characters. As 0x9A is never be a charset-id, it is safe to use - that slot for ASCII. 0x9E and 0x80 are charset-ids of - eight-bit-control and eight-bit-graphic respectively. */ -#define CHAR_TABLE_DEFAULT_SLOT_ASCII (0x9A + 128) -#define CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL (0x9E + 128) -#define CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC (0x80 + 128) - -/* This is the number of slots that apply to characters of ASCII and - 8-bit Europeans only. */ -#define CHAR_TABLE_SINGLE_BYTE_SLOTS 256 + specific range of characters. A sub char-table has the same + structure as a vector. A sub char table appears only in an element + of a char-table, and there's no way to access it directly from + Emacs Lisp program. */ /* This is the number of slots that every char table must have. This counts the ordinary slots and the top, defalt, parent, and purpose slots. */ -#define CHAR_TABLE_STANDARD_SLOTS (CHAR_TABLE_ORDINARY_SLOTS + 4) - -/* This is the number of slots that apply to position-code-1 and - position-code-2 of a multibyte character at the 2nd and 3rd level - sub char tables respectively. */ -#define SUB_CHAR_TABLE_ORDINARY_SLOTS 128 - -/* This is the number of slots that every sub char table must have. - This counts the ordinary slots and the top and defalt slot. */ -#define SUB_CHAR_TABLE_STANDARD_SLOTS (SUB_CHAR_TABLE_ORDINARY_SLOTS + 2) +#define CHAR_TABLE_STANDARD_SLOTS (VECSIZE (struct Lisp_Char_Table) - 1) /* Return the number of "extra" slots in the char table CT. */ @@ -822,70 +785,92 @@ struct Lisp_Vector (((CT)->size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS) /* Almost equivalent to Faref (CT, IDX) with optimization for ASCII - and 8-bit Europeans characters. For these characters, do not check - validity of CT. Do not follow parent. */ -#define CHAR_TABLE_REF(CT, IDX) \ - ((IDX) >= 0 && (IDX) < CHAR_TABLE_SINGLE_BYTE_SLOTS \ - ? (!NILP (XCHAR_TABLE (CT)->contents[IDX]) \ - ? XCHAR_TABLE (CT)->contents[IDX] \ - : XCHAR_TABLE (CT)->defalt) \ - : Faref (CT, make_number (IDX))) + characters. Do not check validity of CT. */ +#define CHAR_TABLE_REF(CT, IDX) \ + ((ASCII_CHAR_P (IDX) \ + && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \ + && !NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX])) \ + ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \ + : char_table_ref ((CT), (IDX))) -/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII - and 8-bit Europeans characters. However, if the result is nil, - return IDX. +/* Almost equivalent to Faref (CT, IDX). However, if the result is + not a character, return IDX. For these characters, do not check validity of CT and do not follow parent. */ -#define CHAR_TABLE_TRANSLATE(CT, IDX) \ - ((IDX) < CHAR_TABLE_SINGLE_BYTE_SLOTS \ - ? (!NILP (XCHAR_TABLE (CT)->contents[IDX]) \ - ? XINT (XCHAR_TABLE (CT)->contents[IDX]) \ - : IDX) \ - : char_table_translate (CT, IDX)) +#define CHAR_TABLE_TRANSLATE(CT, IDX) \ + char_table_translate (CT, IDX) /* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and - 8-bit Europeans characters. Do not check validity of CT. */ -#define CHAR_TABLE_SET(CT, IDX, VAL) \ - do { \ - if (XFASTINT (IDX) < CHAR_TABLE_SINGLE_BYTE_SLOTS) \ - XCHAR_TABLE (CT)->contents[XFASTINT (IDX)] = VAL; \ - else \ - Faset (CT, IDX, VAL); \ - } while (0) + 8-bit European characters. Do not check validity of CT. */ +#define CHAR_TABLE_SET(CT, IDX, VAL) \ + (((IDX) >= 0 && ASCII_CHAR_P (IDX) \ + && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii)) \ + ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \ + : char_table_set (CT, IDX, VAL)) + +#define CHARTAB_SIZE_BITS_0 6 +#define CHARTAB_SIZE_BITS_1 4 +#define CHARTAB_SIZE_BITS_2 5 +#define CHARTAB_SIZE_BITS_3 7 + +extern const int chartab_size[4]; + +struct Lisp_Sub_Char_Table; struct Lisp_Char_Table { /* This is the vector's size field, which also holds the pseudovector type information. It holds the size, too. - The size counts the top, defalt, purpose, and parent slots. - The last three are not counted if this is a sub char table. */ + The size counts the defalt, parent, purpose, ascii, + contents, and extras slots. */ EMACS_UINT size; struct Lisp_Vector *next; - /* This holds a flag to tell if this is a top level char table (t) - or a sub char table (nil). */ - Lisp_Object top; + /* This holds a default value, which is used whenever the value for a specific character is nil. */ Lisp_Object defalt; - /* This holds an actual value of each element. A sub char table - has only SUB_CHAR_TABLE_ORDINARY_SLOTS number of elements. */ - Lisp_Object contents[CHAR_TABLE_ORDINARY_SLOTS]; - /* A sub char table doesn't has the following slots. */ - - /* This points to another char table, which we inherit from - when the value for a specific character is nil. - The `defalt' slot takes precedence over this. */ + /* This points to another char table, which we inherit from when the + value for a specific character is nil. The `defalt' slot takes + precedence over this. */ Lisp_Object parent; - /* This should be a symbol which says what kind of use - this char-table is meant for. - Typically now the values can be `syntax-table' and `display-table'. */ + + /* This is a symbol which says what kind of use this char-table is + meant for. */ Lisp_Object purpose; - /* These hold additional data. */ + + /* The bottom sub char-table for characters of the range 0..127. It + is nil if none of ASCII character has a specific value. */ + Lisp_Object ascii; + + Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)]; + + /* These hold additional data. It is a vector. */ Lisp_Object extras[1]; }; +struct Lisp_Sub_Char_Table + { + /* This is the vector's size field, which also holds the + pseudovector type information. It holds the size, too. */ + EMACS_INT size; + struct Lisp_Vector *next; + + /* Depth of this sub char-table. It should be 1, 2, or 3. A sub + char-table of depth 1 contains 16 elments, and each element + covers 4096 (128*32) characters. A sub char-table of depth 2 + contains 32 elements, and each element covers 128 characters. A + sub char-table of depth 3 contains 128 elements, and each element + is for one character. */ + Lisp_Object depth; + + /* Minimum character covered by the sub char-table. */ + Lisp_Object min_char; + + Lisp_Object contents[1]; + }; + /* A boolvector is a kind of vectorlike, with contents are like a string. */ struct Lisp_Bool_Vector { @@ -1094,7 +1079,6 @@ struct Lisp_Hash_Table (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) #define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) -#define GC_HASH_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_HASH_TABLE) #define CHECK_HASH_TABLE(x) \ CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) @@ -1416,9 +1400,9 @@ typedef unsigned char UCHAR; (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META) -/* Actually, the current Emacs uses 19 bits for the character value +/* Actually, the current Emacs uses 22 bits for the character value itself. */ -#define CHARACTERBITS 19 +#define CHARACTERBITS 22 /* The maximum byte size consumed by push_key_description. All callers should assure that at least this size of memory is @@ -1446,9 +1430,9 @@ typedef unsigned char UCHAR; #define GLYPH int /* Mask bits for face. */ -#define GLYPH_MASK_FACE 0x7FF80000 +#define GLYPH_MASK_FACE 0x7FC00000 /* Mask bits for character code. */ -#define GLYPH_MASK_CHAR 0x0007FFFF /* The lowest 19 bits */ +#define GLYPH_MASK_CHAR 0x003FFFFF /* The lowest 22 bits */ /* The FAST macros assume that we already know we're in an X window. */ @@ -1475,46 +1459,28 @@ typedef unsigned char UCHAR; /* Data type checking */ #define NILP(x) EQ (x, Qnil) -#define GC_NILP(x) GC_EQ (x, Qnil) #define NUMBERP(x) (INTEGERP (x) || FLOATP (x)) -#define GC_NUMBERP(x) (GC_INTEGERP (x) || GC_FLOATP (x)) #define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0) -#define GC_NATNUMP(x) (GC_INTEGERP (x) && XINT (x) >= 0) #define INTEGERP(x) (XTYPE ((x)) == Lisp_Int) -#define GC_INTEGERP(x) INTEGERP (x) #define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol) -#define GC_SYMBOLP(x) (XGCTYPE ((x)) == Lisp_Symbol) #define MISCP(x) (XTYPE ((x)) == Lisp_Misc) -#define GC_MISCP(x) (XGCTYPE ((x)) == Lisp_Misc) #define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike) -#define GC_VECTORLIKEP(x) (XGCTYPE ((x)) == Lisp_Vectorlike) #define STRINGP(x) (XTYPE ((x)) == Lisp_String) -#define GC_STRINGP(x) (XGCTYPE ((x)) == Lisp_String) #define CONSP(x) (XTYPE ((x)) == Lisp_Cons) -#define GC_CONSP(x) (XGCTYPE ((x)) == Lisp_Cons) #define FLOATP(x) (XTYPE ((x)) == Lisp_Float) -#define GC_FLOATP(x) (XGCTYPE ((x)) == Lisp_Float) -#define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG)) -#define GC_VECTORP(x) (GC_VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG)) +#define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG)) #define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) -#define GC_OVERLAYP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay) #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) -#define GC_MARKERP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) #define INTFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd) -#define GC_INTFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd) #define BOOLFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd) -#define GC_BOOLFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd) #define OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd) -#define GC_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd) #define BUFFER_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd) -#define GC_BUFFER_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd) #define BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value) -#define GC_BUFFER_LOCAL_VALUEP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value) +#define SOME_BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Some_Buffer_Local_Value) #define KBOARD_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd) -#define GC_KBOARD_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd) #define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) @@ -1524,36 +1490,18 @@ typedef unsigned char UCHAR; && (((XVECTOR (x)->size & (PSEUDOVECTOR_FLAG | (code)))) \ == (PSEUDOVECTOR_FLAG | (code)))) -/* True if object X is a pseudovector whose code is CODE. - This one works during GC. */ -#define GC_PSEUDOVECTORP(x, code) \ - (GC_VECTORLIKEP (x) \ - && (((XVECTOR (x)->size & (PSEUDOVECTOR_FLAG | (code)))) \ - == (PSEUDOVECTOR_FLAG | (code)))) - /* Test for specific pseudovector types. */ #define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) -#define GC_WINDOW_CONFIGURATIONP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION) #define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS) -#define GC_PROCESSP(x) GC_PSEUDOVECTORP (x, PVEC_PROCESS) #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW) -#define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW) #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL) -#define GC_TERMINALP(x) GC_PSEUDOVECTORP (x, PVEC_TERMINAL) #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR) -#define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR) #define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) -#define GC_COMPILEDP(x) GC_PSEUDOVECTORP (x, PVEC_COMPILED) #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER) -#define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER) #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE) -#define GC_CHAR_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_CHAR_TABLE) +#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE) #define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) -#define GC_BOOL_VECTOR_P(x) GC_PSEUDOVECTORP (x, PVEC_BOOL_VECTOR) #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME) -#define GC_FRAMEP(x) GC_PSEUDOVECTORP (x, PVEC_FRAME) - -#define SUB_CHAR_TABLE_P(x) (CHAR_TABLE_P (x) && NILP (XCHAR_TABLE (x)->top)) /* Test for image (image . spec) */ #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) @@ -1563,8 +1511,6 @@ typedef unsigned char UCHAR; #define ARRAYP(x) \ (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) -#define GC_EQ(x, y) EQ (x, y) - #define CHECK_LIST(x) \ CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) @@ -1670,6 +1616,20 @@ typedef unsigned char UCHAR; XSETCDR ((x), tmp); \ } while (0) +#define CHECK_NATNUM_CAR(x) \ + do { \ + Lisp_Object tmp = XCAR (x); \ + CHECK_NATNUM (tmp); \ + XSETCAR ((x), tmp); \ + } while (0) + +#define CHECK_NATNUM_CDR(x) \ + do { \ + Lisp_Object tmp = XCDR (x); \ + CHECK_NATNUM (tmp); \ + XSETCDR ((x), tmp); \ + } while (0) + /* Cast pointers to this type to compare them. Some machines want int. */ #ifndef PNTR_COMPARISON_TYPE #define PNTR_COMPARISON_TYPE EMACS_UINT @@ -2304,34 +2264,44 @@ extern void keys_of_cmds P_ ((void)); /* Defined in coding.c */ EXFUN (Fcoding_system_p, 1); +EXFUN (Fcoding_system_base, 1); +EXFUN (Fcoding_system_eol_type, 1); +EXFUN (Fcheck_coding_system, 1); EXFUN (Fcheck_coding_system, 1); EXFUN (Fread_coding_system, 2); EXFUN (Fread_non_nil_coding_system, 1); EXFUN (Ffind_operation_coding_system, MANY); EXFUN (Fupdate_coding_systems_internal, 0); -EXFUN (Fencode_coding_string, 3); -EXFUN (Fdecode_coding_string, 3); -extern Lisp_Object detect_coding_system P_ ((const unsigned char *, int, int, - int)); +EXFUN (Fencode_coding_string, 4); +EXFUN (Fdecode_coding_string, 4); +extern Lisp_Object detect_coding_system P_ ((const unsigned char *, int, + int, int, int, Lisp_Object)); extern void init_coding P_ ((void)); extern void init_coding_once P_ ((void)); extern void syms_of_coding P_ ((void)); -extern Lisp_Object code_convert_string_norecord P_ ((Lisp_Object, Lisp_Object, - int)); + +/* Defined in character.c */ +extern void init_character_once P_ ((void)); +extern void syms_of_character P_ ((void)); +EXFUN (Funibyte_char_to_multibyte, 1); /* Defined in charset.c */ -extern EMACS_INT nonascii_insert_offset; -extern Lisp_Object Vnonascii_translation_table; EXFUN (Fchar_bytes, 1); EXFUN (Fchar_width, 1); EXFUN (Fstring, MANY); extern int chars_in_text P_ ((const unsigned char *, int)); extern int multibyte_chars_in_text P_ ((const unsigned char *, int)); -extern int unibyte_char_to_multibyte P_ ((int)); extern int multibyte_char_to_unibyte P_ ((int, Lisp_Object)); +extern int multibyte_char_to_unibyte_safe P_ ((int)); extern Lisp_Object Qcharset; +extern void init_charset P_ ((void)); extern void init_charset_once P_ ((void)); extern void syms_of_charset P_ ((void)); +/* Structure forward declarations. */ +struct charset; + +/* Defined in composite.c */ +extern void syms_of_composite P_ ((void)); /* Defined in syntax.c */ EXFUN (Fforward_word, 1); @@ -2349,9 +2319,8 @@ extern int next_almost_prime P_ ((int)); extern Lisp_Object larger_vector P_ ((Lisp_Object, int, Lisp_Object)); extern void sweep_weak_hash_tables P_ ((void)); extern Lisp_Object Qstring_lessp; -EXFUN (Foptimize_char_table, 1); extern Lisp_Object Vfeatures; -extern Lisp_Object QCtest, QCweakness, Qequal; +extern Lisp_Object QCtest, QCweakness, Qequal, Qeq; unsigned sxhash P_ ((Lisp_Object, int)); Lisp_Object make_hash_table P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, @@ -2366,6 +2335,7 @@ void remove_hash_entry P_ ((struct Lisp_Hash_Table *, int)); extern void init_fns P_ ((void)); EXFUN (Fsxhash, 1); EXFUN (Fmake_hash_table, MANY); +EXFUN (Fmakehash, 1); EXFUN (Fcopy_hash_table, 1); EXFUN (Fhash_table_count, 1); EXFUN (Fhash_table_rehash_size, 1); @@ -2424,6 +2394,7 @@ extern Lisp_Object concat2 P_ ((Lisp_Object, Lisp_Object)); extern Lisp_Object concat3 P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); extern Lisp_Object nconc2 P_ ((Lisp_Object, Lisp_Object)); extern Lisp_Object assq_no_quit P_ ((Lisp_Object, Lisp_Object)); +extern Lisp_Object assoc_no_quit P_ ((Lisp_Object, Lisp_Object)); extern void clear_string_char_byte_cache P_ ((void)); extern int string_char_to_byte P_ ((Lisp_Object, int)); extern int string_byte_to_char P_ ((Lisp_Object, int)); @@ -2434,18 +2405,10 @@ EXFUN (Fcopy_alist, 1); EXFUN (Fplist_get, 2); EXFUN (Fplist_put, 3); EXFUN (Fplist_member, 2); -EXFUN (Fset_char_table_parent, 2); -EXFUN (Fchar_table_extra_slot, 2); -EXFUN (Fset_char_table_extra_slot, 3); EXFUN (Frassoc, 2); EXFUN (Fstring_equal, 2); EXFUN (Fcompare_strings, 7); EXFUN (Fstring_lessp, 2); -extern int char_table_translate P_ ((Lisp_Object, int)); -extern void map_char_table P_ ((void (*) (Lisp_Object, Lisp_Object, Lisp_Object), - Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int, - int *)); -extern Lisp_Object char_table_ref_and_index P_ ((Lisp_Object, int, int *)); extern void syms_of_fns P_ ((void)); /* Defined in floatfns.c */ @@ -2478,6 +2441,7 @@ extern void insert P_ ((const unsigned char *, int)); extern void insert_and_inherit P_ ((const unsigned char *, int)); extern void insert_1 P_ ((const unsigned char *, int, int, int, int)); extern void insert_1_both P_ ((const unsigned char *, int, int, int, int, int)); +extern void insert_from_gap P_ ((int, int)); extern void insert_from_string P_ ((Lisp_Object, int, int, int, int, int)); extern void insert_from_buffer P_ ((struct buffer *, int, int, int)); extern void insert_char P_ ((int)); @@ -2604,8 +2568,6 @@ extern Lisp_Object make_pure_vector P_ ((EMACS_INT)); EXFUN (Fgarbage_collect, 0); EXFUN (Fmake_byte_code, MANY); EXFUN (Fmake_bool_vector, 2); -EXFUN (Fmake_char_table, 2); -extern Lisp_Object make_sub_char_table P_ ((Lisp_Object)); extern Lisp_Object Qchar_table_extra_slots; extern struct Lisp_Vector *allocate_vector P_ ((EMACS_INT)); extern struct Lisp_Vector *allocate_pseudovector P_ ((int memlen, int lisplen, EMACS_INT tag)); @@ -2633,6 +2595,31 @@ extern void syms_of_alloc P_ ((void)); extern struct buffer * allocate_buffer P_ ((void)); extern int valid_lisp_object_p P_ ((Lisp_Object)); +/* Defined in chartab.c */ +EXFUN (Fmake_char_table, 2); +EXFUN (Fchar_table_parent, 1); +EXFUN (Fset_char_table_parent, 2); +EXFUN (Fchar_table_extra_slot, 2); +EXFUN (Fset_char_table_extra_slot, 3); +EXFUN (Fchar_table_range, 2); +EXFUN (Fset_char_table_range, 3); +EXFUN (Fset_char_table_default, 3); +EXFUN (Foptimize_char_table, 1); +EXFUN (Fmap_char_table, 2); +extern Lisp_Object copy_char_table P_ ((Lisp_Object)); +extern Lisp_Object sub_char_table_ref P_ ((Lisp_Object, int)); +extern Lisp_Object char_table_ref P_ ((Lisp_Object, int)); +extern Lisp_Object char_table_ref_and_range P_ ((Lisp_Object, int, + int *, int *)); +extern Lisp_Object char_table_set P_ ((Lisp_Object, int, Lisp_Object)); +extern Lisp_Object char_table_set_range P_ ((Lisp_Object, int, int, + Lisp_Object)); +extern int char_table_translate P_ ((Lisp_Object, int)); +extern void map_char_table P_ ((void (*) (Lisp_Object, Lisp_Object, + Lisp_Object), + Lisp_Object, Lisp_Object, Lisp_Object)); +extern void syms_of_chartab P_ ((void)); + /* Defined in print.c */ extern Lisp_Object Vprin1_to_string_buffer; extern void debug_print P_ ((Lisp_Object)); @@ -2846,6 +2833,7 @@ extern int overlay_touches_p P_ ((int)); extern Lisp_Object Vbuffer_alist, Vinhibit_read_only; EXFUN (Fget_buffer, 1); EXFUN (Fget_buffer_create, 1); +EXFUN (Fgenerate_new_buffer_name, 2); EXFUN (Fset_buffer, 1); EXFUN (set_buffer_if_live, 1); EXFUN (Fbarf_if_buffer_read_only, 0); @@ -3189,6 +3177,7 @@ extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks; EXFUN (Fnext_single_property_change, 4); EXFUN (Fnext_single_char_property_change, 4); EXFUN (Fprevious_single_property_change, 4); +EXFUN (Fget_text_property, 3); EXFUN (Fput_text_property, 5); EXFUN (Fget_text_property, 3); EXFUN (Fprevious_char_property_change, 2); @@ -3250,6 +3239,7 @@ extern void init_sound P_ ((void)); /* Defined in category.c */ extern void init_category_once P_ ((void)); +extern Lisp_Object char_category_set P_ ((int)); extern void syms_of_category P_ ((void)); /* Defined in ccl.c */ @@ -3269,7 +3259,8 @@ extern void syms_of_terminal P_ ((void)); #ifdef HAVE_WINDOW_SYSTEM /* Defined in fontset.c */ extern void syms_of_fontset P_ ((void)); -EXFUN (Fset_fontset_font, 4); +EXFUN (Fset_fontset_font, 5); +EXFUN (Fnew_fontset, 2); /* Defined in xfns.c, w32fns.c, or macfns.c */ EXFUN (Fxw_display_color_p, 1); diff --git a/src/lread.c b/src/lread.c index ee020fd43d3..6674f840686 100644 --- a/src/lread.c +++ b/src/lread.c @@ -31,7 +31,9 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "intervals.h" #include "buffer.h" +#include "character.h" #include "charset.h" +#include "coding.h" #include <epaths.h> #include "commands.h" #include "keyboard.h" @@ -92,6 +94,12 @@ Lisp_Object Qinhibit_file_name_operation; Lisp_Object Qeval_buffer_list, Veval_buffer_list; Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */ +/* Used instead of Qget_file_char while loading *.elc files compiled + by Emacs 21 or older. */ +static Lisp_Object Qget_emacs_mule_file_char; + +static Lisp_Object Qload_force_doc_strings; + extern Lisp_Object Qevent_symbol_element_mask; extern Lisp_Object Qfile_exists_p; @@ -135,6 +143,11 @@ static int load_force_doc_strings; /* Nonzero means read should convert strings to unibyte. */ static int load_convert_to_unibyte; +/* Nonzero means READCHAR should read bytes one by one (not character) + when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char. + This is set to 1 by read1 temporarily while handling #@NUMBER. */ +static int load_each_byte; + /* Function to use for loading an Emacs Lisp source file (not compiled) instead of readevalloop. */ Lisp_Object Vload_source_file_function; @@ -163,9 +176,6 @@ static int read_from_string_index; static int read_from_string_index_byte; static int read_from_string_limit; -/* Number of bytes left to read in the buffer character - that `readchar' has already advanced over. */ -static int readchar_backlog; /* Number of characters read in the current call to Fread or Fread_from_string. */ static int readchar_count; @@ -210,7 +220,9 @@ int load_dangerous_libraries; static Lisp_Object Vbytecomp_version_regexp; -static void to_multibyte P_ ((char **, char **, int *)); +static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object), + Lisp_Object)); + static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, Lisp_Object (*) (), int, Lisp_Object, Lisp_Object, @@ -222,29 +234,48 @@ static void invalid_syntax P_ ((const char *, int)) NO_RETURN; static void end_of_file_error P_ (()) NO_RETURN; +/* Functions that read one byte from the current source READCHARFUN + or unreads one byte. If the integer argument C is -1, it returns + one read byte, or -1 when there's no more byte in the source. If C + is 0 or positive, it unreads C, and the return value is not + interesting. */ + +static int readbyte_for_lambda P_ ((int, Lisp_Object)); +static int readbyte_from_file P_ ((int, Lisp_Object)); +static int readbyte_from_string P_ ((int, Lisp_Object)); + /* Handle unreading and rereading of characters. Write READCHAR to read a character, UNREAD(c) to unread c to be read again. - The READCHAR and UNREAD macros are meant for reading/unreading a - byte code; they do not handle multibyte characters. The caller - should manage them if necessary. + These macros correctly read/unread multibyte characters. */ - [ Actually that seems to be a lie; READCHAR will definitely read - multibyte characters from buffer sources, at least. Is the - comment just out of date? - -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ] - */ - -#define READCHAR readchar (readcharfun) +#define READCHAR readchar (readcharfun, NULL) #define UNREAD(c) unreadchar (readcharfun, c) +/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */ +#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte) + +/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char, + Qlambda, or a cons, we use this to keep an unread character because + a file stream can't handle multibyte-char unreading. The value -1 + means that there's no unread character. */ +static int unread_char; + static int -readchar (readcharfun) +readchar (readcharfun, multibyte) Lisp_Object readcharfun; + int *multibyte; { Lisp_Object tem; register int c; + int (*readbyte) P_ ((int, Lisp_Object)); + unsigned char buf[MAX_MULTIBYTE_LENGTH]; + int i, len; + int emacs_mule_encoding = 0; + + if (multibyte) + *multibyte = 0; readchar_count++; @@ -253,31 +284,24 @@ readchar (readcharfun) register struct buffer *inbuffer = XBUFFER (readcharfun); int pt_byte = BUF_PT_BYTE (inbuffer); - int orig_pt_byte = pt_byte; - - if (readchar_backlog > 0) - /* We get the address of the byte just passed, - which is the last byte of the character. - The other bytes in this character are consecutive with it, - because the gap can't be in the middle of a character. */ - return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1) - - --readchar_backlog); if (pt_byte >= BUF_ZV_BYTE (inbuffer)) return -1; - readchar_backlog = -1; - if (! NILP (inbuffer->enable_multibyte_characters)) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); BUF_INC_POS (inbuffer, pt_byte); c = STRING_CHAR (p, pt_byte - orig_pt_byte); + if (multibyte) + *multibyte = 1; } else { c = BUF_FETCH_BYTE (inbuffer, pt_byte); + if (! ASCII_BYTE_P (c)) + c = BYTE8_TO_CHAR (c); pt_byte++; } SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte); @@ -289,31 +313,24 @@ readchar (readcharfun) register struct buffer *inbuffer = XMARKER (readcharfun)->buffer; int bytepos = marker_byte_position (readcharfun); - int orig_bytepos = bytepos; - - if (readchar_backlog > 0) - /* We get the address of the byte just passed, - which is the last byte of the character. - The other bytes in this character are consecutive with it, - because the gap can't be in the middle of a character. */ - return *(BUF_BYTE_ADDRESS (inbuffer, XMARKER (readcharfun)->bytepos - 1) - - --readchar_backlog); if (bytepos >= BUF_ZV_BYTE (inbuffer)) return -1; - readchar_backlog = -1; - if (! NILP (inbuffer->enable_multibyte_characters)) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); BUF_INC_POS (inbuffer, bytepos); c = STRING_CHAR (p, bytepos - orig_bytepos); + if (multibyte) + *multibyte = 1; } else { c = BUF_FETCH_BYTE (inbuffer, bytepos); + if (! ASCII_BYTE_P (c)) + c = BYTE8_TO_CHAR (c); bytepos++; } @@ -324,44 +341,95 @@ readchar (readcharfun) } if (EQ (readcharfun, Qlambda)) - return read_bytecode_char (0); + { + readbyte = readbyte_for_lambda; + goto read_multibyte; + } if (EQ (readcharfun, Qget_file_char)) { - BLOCK_INPUT; - c = getc (instream); -#ifdef EINTR - /* Interrupted reads have been observed while reading over the network */ - while (c == EOF && ferror (instream) && errno == EINTR) - { - UNBLOCK_INPUT; - QUIT; - BLOCK_INPUT; - clearerr (instream); - c = getc (instream); - } -#endif - UNBLOCK_INPUT; - return c; + readbyte = readbyte_from_file; + goto read_multibyte; } if (STRINGP (readcharfun)) { if (read_from_string_index >= read_from_string_limit) c = -1; + else if (STRING_MULTIBYTE (readcharfun)) + { + if (multibyte) + *multibyte = 1; + FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun, + read_from_string_index, + read_from_string_index_byte); + } else - FETCH_STRING_CHAR_ADVANCE (c, readcharfun, - read_from_string_index, - read_from_string_index_byte); - + { + c = SREF (readcharfun, read_from_string_index_byte); + read_from_string_index++; + read_from_string_index_byte++; + } return c; } + if (CONSP (readcharfun)) + { + /* This is the case that read_vector is reading from a unibyte + string that contains a byte sequence previously skipped + because of #@NUMBER. The car part of readcharfun is that + string, and the cdr part is a value of readcharfun given to + read_vector. */ + readbyte = readbyte_from_string; + if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char)) + emacs_mule_encoding = 1; + goto read_multibyte; + } + + if (EQ (readcharfun, Qget_emacs_mule_file_char)) + { + readbyte = readbyte_from_file; + emacs_mule_encoding = 1; + goto read_multibyte; + } + tem = call0 (readcharfun); if (NILP (tem)) return -1; return XINT (tem); + + read_multibyte: + if (unread_char >= 0) + { + c = unread_char; + unread_char = -1; + return c; + } + c = (*readbyte) (-1, readcharfun); + if (c < 0 || load_each_byte) + return c; + if (multibyte) + *multibyte = 1; + if (ASCII_BYTE_P (c)) + return c; + if (emacs_mule_encoding) + return read_emacs_mule_char (c, readbyte, readcharfun); + i = 0; + buf[i++] = c; + len = BYTES_BY_CHAR_HEAD (c); + while (i < len) + { + c = (*readbyte) (-1, readcharfun); + if (c < 0 || ! TRAILING_CODE_P (c)) + { + while (--i > 1) + (*readbyte) (buf[i], readcharfun); + return BYTE8_TO_CHAR (buf[0]); + } + buf[i++] = c; + } + return STRING_CHAR (buf, i); } /* Unread the character C in the way appropriate for the stream READCHARFUN. @@ -382,36 +450,26 @@ unreadchar (readcharfun, c) struct buffer *b = XBUFFER (readcharfun); int bytepos = BUF_PT_BYTE (b); - if (readchar_backlog >= 0) - readchar_backlog++; + BUF_PT (b)--; + if (! NILP (b->enable_multibyte_characters)) + BUF_DEC_POS (b, bytepos); else - { - BUF_PT (b)--; - if (! NILP (b->enable_multibyte_characters)) - BUF_DEC_POS (b, bytepos); - else - bytepos--; + bytepos--; - BUF_PT_BYTE (b) = bytepos; - } + BUF_PT_BYTE (b) = bytepos; } else if (MARKERP (readcharfun)) { struct buffer *b = XMARKER (readcharfun)->buffer; int bytepos = XMARKER (readcharfun)->bytepos; - if (readchar_backlog >= 0) - readchar_backlog++; + XMARKER (readcharfun)->charpos--; + if (! NILP (b->enable_multibyte_characters)) + BUF_DEC_POS (b, bytepos); else - { - XMARKER (readcharfun)->charpos--; - if (! NILP (b->enable_multibyte_characters)) - BUF_DEC_POS (b, bytepos); - else - bytepos--; + bytepos--; - XMARKER (readcharfun)->bytepos = bytepos; - } + XMARKER (readcharfun)->bytepos = bytepos; } else if (STRINGP (readcharfun)) { @@ -419,18 +477,165 @@ unreadchar (readcharfun, c) read_from_string_index_byte = string_char_to_byte (readcharfun, read_from_string_index); } + else if (CONSP (readcharfun)) + { + unread_char = c; + } else if (EQ (readcharfun, Qlambda)) - read_bytecode_char (1); - else if (EQ (readcharfun, Qget_file_char)) + { + unread_char = c; + } + else if (EQ (readcharfun, Qget_file_char) + || EQ (readcharfun, Qget_emacs_mule_file_char)) + { + if (load_each_byte) + { + BLOCK_INPUT; + ungetc (c, instream); + UNBLOCK_INPUT; + } + else + unread_char = c; + } + else + call1 (readcharfun, make_number (c)); +} + +static int +readbyte_for_lambda (c, readcharfun) + int c; + Lisp_Object readcharfun; +{ + return read_bytecode_char (c >= 0); +} + + +static int +readbyte_from_file (c, readcharfun) + int c; + Lisp_Object readcharfun; +{ + if (c >= 0) { BLOCK_INPUT; ungetc (c, instream); UNBLOCK_INPUT; + return 0; + } + + BLOCK_INPUT; + c = getc (instream); + +#ifdef EINTR + /* Interrupted reads have been observed while reading over the network */ + while (c == EOF && ferror (instream) && errno == EINTR) + { + UNBLOCK_INPUT; + QUIT; + BLOCK_INPUT; + clearerr (instream); + c = getc (instream); + } +#endif + + UNBLOCK_INPUT; + + return (c == EOF ? -1 : c); +} + +static int +readbyte_from_string (c, readcharfun) + int c; + Lisp_Object readcharfun; +{ + Lisp_Object string = XCAR (readcharfun); + + if (c >= 0) + { + read_from_string_index--; + read_from_string_index_byte + = string_char_to_byte (string, read_from_string_index); } + + if (read_from_string_index >= read_from_string_limit) + c = -1; else - call1 (readcharfun, make_number (c)); + FETCH_STRING_CHAR_ADVANCE (c, string, + read_from_string_index, + read_from_string_index_byte); + return c; +} + + +/* Read one non-ASCII character from INSTREAM. The character is + encoded in `emacs-mule' and the first byte is already read in + C. */ + +extern char emacs_mule_bytes[256]; + +static int +read_emacs_mule_char (c, readbyte, readcharfun) + int c; + int (*readbyte) P_ ((int, Lisp_Object)); + Lisp_Object readcharfun; +{ + /* Emacs-mule coding uses at most 4-byte for one character. */ + unsigned char buf[4]; + int len = emacs_mule_bytes[c]; + struct charset *charset; + int i; + unsigned code; + + if (len == 1) + /* C is not a valid leading-code of `emacs-mule'. */ + return BYTE8_TO_CHAR (c); + + i = 0; + buf[i++] = c; + while (i < len) + { + c = (*readbyte) (-1, readcharfun); + if (c < 0xA0) + { + while (--i > 1) + (*readbyte) (buf[i], readcharfun); + return BYTE8_TO_CHAR (buf[0]); + } + buf[i++] = c; + } + + if (len == 2) + { + charset = emacs_mule_charset[buf[0]]; + code = buf[1] & 0x7F; + } + else if (len == 3) + { + if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11 + || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12) + { + charset = emacs_mule_charset[buf[1]]; + code = buf[2] & 0x7F; + } + else + { + charset = emacs_mule_charset[buf[0]]; + code = ((buf[1] << 8) | buf[2]) & 0x7F7F; + } + } + else + { + charset = emacs_mule_charset[buf[1]]; + code = ((buf[2] << 8) | buf[3]) & 0x7F7F; + } + c = DECODE_CHAR (charset, code); + if (c < 0) + Fsignal (Qinvalid_read_syntax, + Fcons (build_string ("invalid multibyte form"), Qnil)); + return c; } + static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); static Lisp_Object read0 P_ ((Lisp_Object)); @@ -438,7 +643,6 @@ static Lisp_Object read1 P_ ((Lisp_Object, int *, int)); static Lisp_Object read_list P_ ((int, Lisp_Object)); static Lisp_Object read_vector P_ ((Lisp_Object, int)); -static int read_multibyte P_ ((int, Lisp_Object)); static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); @@ -645,11 +849,11 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, -/* Value is non-zero if the file associated with file descriptor FD - is a compiled Lisp file that's safe to load. Only files compiled - with Emacs are safe to load. Files compiled with XEmacs can lead - to a crash in Fbyte_code because of an incompatible change in the - byte compiler. */ +/* Value is a version number of byte compiled code if the file + associated with file descriptor FD is a compiled Lisp file that's + safe to load. Only files compiled with Emacs are safe to load. + Files compiled with XEmacs can lead to a crash in Fbyte_code + because of an incompatible change in the byte compiler. */ static int safe_to_load_p (fd) @@ -658,6 +862,7 @@ safe_to_load_p (fd) char buf[512]; int nbytes, i; int safe_p = 1; + int version = 1; /* Read the first few bytes from the file, and look for a line specifying the byte compiler version used. */ @@ -667,15 +872,18 @@ safe_to_load_p (fd) buf[nbytes] = '\0'; /* Skip to the next newline, skipping over the initial `ELC' - with NUL bytes following it. */ + with NUL bytes following it, but note the version. */ for (i = 0; i < nbytes && buf[i] != '\n'; ++i) - ; + if (i == 4) + version = buf[i]; - if (i < nbytes - && fast_c_string_match_ignore_case (Vbytecomp_version_regexp, + if (i == nbytes + || fast_c_string_match_ignore_case (Vbytecomp_version_regexp, buf + i) < 0) safe_p = 0; } + if (safe_p) + safe_p = version; lseek (fd, 0, SEEK_SET); return safe_p; @@ -789,6 +997,8 @@ Return t if the file exists and loads successfully. */) int safe_p = 1; char *fmode = "r"; Lisp_Object tmp[2]; + int version; + #ifdef DOS_NT fmode = "rt"; #endif /* DOS_NT */ @@ -912,12 +1122,15 @@ Return t if the file exists and loads successfully. */) tmp)) : found) ; + version = -1; + /* Check for the presence of old-style quotes and warn about them. */ specbind (Qold_style_backquotes, Qnil); record_unwind_protect (load_warn_old_style_backquotes, file); if (!bcmp (SDATA (found) + SBYTES (found) - 4, - ".elc", 4)) + ".elc", 4) + || (version = safe_to_load_p (fd)) > 0) /* Load .elc files directly, but not when they are remote and have no handler! */ { @@ -928,7 +1141,8 @@ Return t if the file exists and loads successfully. */) GCPRO3 (file, found, hist_file_name); - if (!safe_to_load_p (fd)) + if (version < 0 + && ! (version = safe_to_load_p (fd))) { safe_p = 0; if (!load_dangerous_libraries) @@ -1026,8 +1240,17 @@ Return t if the file exists and loads successfully. */) load_descriptor_list = Fcons (make_number (fileno (stream)), load_descriptor_list); load_in_progress++; - readevalloop (Qget_file_char, stream, hist_file_name, - Feval, 0, Qnil, Qnil, Qnil, Qnil); + if (! version || version >= 22) + readevalloop (Qget_file_char, stream, hist_file_name, + Feval, 0, Qnil, Qnil, Qnil, Qnil); + else + { + /* We can't handle a file which was compiled with + byte-compile-dynamic by older version of Emacs. */ + specbind (Qload_force_doc_strings, Qt); + readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval, + 0, Qnil, Qnil, Qnil, Qnil); + } unbind_to (count, Qnil); /* Run any eval-after-load forms for this file */ @@ -1456,8 +1679,6 @@ readevalloop (readcharfun, stream, sourcename, evalfun, record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); load_convert_to_unibyte = !NILP (unibyte); - readchar_backlog = -1; - GCPRO4 (sourcename, readfun, start, end); /* Try to ensure sourcename is a truename, except whilst preloading. */ @@ -1714,7 +1935,6 @@ read_internal_start (stream, start, end) { Lisp_Object retval; - readchar_backlog = -1; readchar_count = 0; new_backquote_flag = 0; read_objects = Qnil; @@ -1722,17 +1942,25 @@ read_internal_start (stream, start, end) || EQ (Vread_with_symbol_positions, stream)) Vread_symbol_positions_list = Qnil; - if (STRINGP (stream)) + if (STRINGP (stream) + || ((CONSP (stream) && STRINGP (XCAR (stream))))) { int startval, endval; + Lisp_Object string; + + if (STRINGP (stream)) + string = stream; + else + string = XCAR (stream); + if (NILP (end)) - endval = SCHARS (stream); + endval = SCHARS (string); else { CHECK_NUMBER (end); endval = XINT (end); - if (endval < 0 || endval > SCHARS (stream)) - args_out_of_range (stream, end); + if (endval < 0 || endval > SCHARS (string)) + args_out_of_range (string, end); } if (NILP (start)) @@ -1742,10 +1970,10 @@ read_internal_start (stream, start, end) CHECK_NUMBER (start); startval = XINT (start); if (startval < 0 || startval > endval) - args_out_of_range (stream, start); + args_out_of_range (string, start); } read_from_string_index = startval; - read_from_string_index_byte = string_char_to_byte (stream, startval); + read_from_string_index_byte = string_char_to_byte (string, startval); read_from_string_limit = endval; } @@ -1792,59 +2020,19 @@ read0 (readcharfun) static int read_buffer_size; static char *read_buffer; -/* Read multibyte form and return it as a character. C is a first - byte of multibyte form, and rest of them are read from - READCHARFUN. */ - -static int -read_multibyte (c, readcharfun) - register int c; - Lisp_Object readcharfun; -{ - /* We need the actual character code of this multibyte - characters. */ - unsigned char str[MAX_MULTIBYTE_LENGTH]; - int len = 0; - int bytes; - - if (c < 0) - return c; - - str[len++] = c; - while ((c = READCHAR) >= 0xA0 - && len < MAX_MULTIBYTE_LENGTH) - { - str[len++] = c; - readchar_count--; - } - UNREAD (c); - if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes)) - return STRING_CHAR (str, len); - /* The byte sequence is not valid as multibyte. Unread all bytes - but the first one, and return the first byte. */ - while (--len > 0) - UNREAD (str[len]); - return str[0]; -} - /* Read a \-escape sequence, assuming we already read the `\'. - If the escape sequence forces unibyte, store 1 into *BYTEREP. - If the escape sequence forces multibyte, store 2 into *BYTEREP. - Otherwise store 0 into *BYTEREP. */ + If the escape sequence forces unibyte, return eight-bit char. */ static int -read_escape (readcharfun, stringp, byterep) +read_escape (readcharfun, stringp) Lisp_Object readcharfun; int stringp; - int *byterep; { register int c = READCHAR; /* \u allows up to four hex digits, \U up to eight. Default to the behaviour for \u, and change this value in the case that \U is seen. */ int unicode_hex_count = 4; - *byterep = 0; - switch (c) { case -1: @@ -1881,7 +2069,7 @@ read_escape (readcharfun, stringp, byterep) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0, byterep); + c = read_escape (readcharfun, 0); return c | meta_modifier; case 'S': @@ -1890,7 +2078,7 @@ read_escape (readcharfun, stringp, byterep) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0, byterep); + c = read_escape (readcharfun, 0); return c | shift_modifier; case 'H': @@ -1899,7 +2087,7 @@ read_escape (readcharfun, stringp, byterep) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0, byterep); + c = read_escape (readcharfun, 0); return c | hyper_modifier; case 'A': @@ -1908,7 +2096,7 @@ read_escape (readcharfun, stringp, byterep) error ("Invalid escape character syntax"); c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0, byterep); + c = read_escape (readcharfun, 0); return c | alt_modifier; case 's': @@ -1920,7 +2108,7 @@ read_escape (readcharfun, stringp, byterep) } c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0, byterep); + c = read_escape (readcharfun, 0); return c | super_modifier; case 'C': @@ -1930,7 +2118,7 @@ read_escape (readcharfun, stringp, byterep) case '^': c = READCHAR; if (c == '\\') - c = read_escape (readcharfun, 0, byterep); + c = read_escape (readcharfun, 0); if ((c & ~CHAR_MODIFIER_MASK) == '?') return 0177 | (c & CHAR_MODIFIER_MASK); else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK))) @@ -1970,7 +2158,8 @@ read_escape (readcharfun, stringp, byterep) } } - *byterep = 1; + if (i >= 0x80 && i < 0x100) + i = BYTE8_TO_CHAR (i); return i; } @@ -1978,6 +2167,7 @@ read_escape (readcharfun, stringp, byterep) /* A hex escape, as in ANSI C. */ { int i = 0; + int count = 0; while (1) { c = READCHAR; @@ -2000,9 +2190,11 @@ read_escape (readcharfun, stringp, byterep) UNREAD (c); break; } + count++; } - *byterep = 2; + if (count < 3 && i >= 0x80) + return BYTE8_TO_CHAR (i); return i; } @@ -2016,8 +2208,6 @@ read_escape (readcharfun, stringp, byterep) { int i = 0; int count = 0; - Lisp_Object lisp_char; - struct gcpro gcpro1; while (++count <= unicode_hex_count) { @@ -2034,22 +2224,10 @@ read_escape (readcharfun, stringp, byterep) } } - GCPRO1 (readcharfun); - lisp_char = call2 (intern ("decode-char"), intern ("ucs"), - make_number (i)); - UNGCPRO; - - if (NILP (lisp_char)) - { - error ("Unsupported Unicode code point: U+%x", (unsigned)i); - } - - return XFASTINT (lisp_char); + return i; } default: - if (BASE_LEADING_CODE_P (c)) - c = read_multibyte (c, readcharfun); return c; } } @@ -2120,43 +2298,6 @@ read_integer (readcharfun, radix) } -/* Convert unibyte text in read_buffer to multibyte. - - Initially, *P is a pointer after the end of the unibyte text, and - the pointer *END points after the end of read_buffer. - - If read_buffer doesn't have enough room to hold the result - of the conversion, reallocate it and adjust *P and *END. - - At the end, make *P point after the result of the conversion, and - return in *NCHARS the number of characters in the converted - text. */ - -static void -to_multibyte (p, end, nchars) - char **p, **end; - int *nchars; -{ - int nbytes; - - parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars); - if (read_buffer_size < 2 * nbytes) - { - int offset = *p - read_buffer; - read_buffer_size = 2 * max (read_buffer_size, nbytes); - read_buffer = (char *) xrealloc (read_buffer, read_buffer_size); - *p = read_buffer + offset; - *end = read_buffer + read_buffer_size; - } - - if (nbytes != *nchars) - nbytes = str_as_multibyte (read_buffer, read_buffer_size, - *p - read_buffer, nchars); - - *p = read_buffer + nbytes; -} - - /* If the next token is ')' or ']' or '.', we store that character in *PCH and the return value is not interesting. Else, we store zero in *PCH and we read and return one lisp object. @@ -2171,12 +2312,14 @@ read1 (readcharfun, pch, first_in_list) { register int c; int uninterned_symbol = 0; + int multibyte; *pch = 0; + load_each_byte = 0; retry: - c = READCHAR; + c = READCHAR_REPORT_MULTIBYTE (&multibyte); if (c < 0) end_of_file_error (); @@ -2204,11 +2347,9 @@ read1 (readcharfun, pch, first_in_list) { Lisp_Object tmp; tmp = read_vector (readcharfun, 0); - if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS - || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10) + if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS) error ("Invalid size char-table"); XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE); - XCHAR_TABLE (tmp)->top = Qt; return tmp; } else if (c == '^') @@ -2217,11 +2358,18 @@ read1 (readcharfun, pch, first_in_list) if (c == '[') { Lisp_Object tmp; + int depth, size; + tmp = read_vector (readcharfun, 0); - if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS) + if (!INTEGERP (AREF (tmp, 0))) + error ("Invalid depth in char-table"); + depth = XINT (AREF (tmp, 0)); + if (depth < 1 || depth > 3) + error ("Invalid depth in char-table"); + size = XVECTOR (tmp)->size - 2; + if (chartab_size [depth] != size) error ("Invalid size char-table"); - XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE); - XCHAR_TABLE (tmp)->top = Qnil; + XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE); return tmp; } invalid_syntax ("#^^", 3); @@ -2242,12 +2390,14 @@ read1 (readcharfun, pch, first_in_list) UNREAD (c); tmp = read1 (readcharfun, pch, first_in_list); - if (size_in_chars != SCHARS (tmp) - /* We used to print 1 char too many - when the number of bits was a multiple of 8. - Accept such input in case it came from an old version. */ - && ! (XFASTINT (length) - == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) + if (STRING_MULTIBYTE (tmp) + || (size_in_chars != SCHARS (tmp) + /* We used to print 1 char too many + when the number of bits was a multiple of 8. + Accept such input in case it came from an old + version. */ + && ! (XFASTINT (length) + == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))) invalid_syntax ("#&...", 5); val = Fmake_bool_vector (length, Qnil); @@ -2309,6 +2459,7 @@ read1 (readcharfun, pch, first_in_list) { int i, nskip = 0; + load_each_byte = 1; /* Read a decimal integer. */ while ((c = READCHAR) >= 0 && c >= '0' && c <= '9') @@ -2319,7 +2470,9 @@ read1 (readcharfun, pch, first_in_list) if (c >= 0) UNREAD (c); - if (load_force_doc_strings && EQ (readcharfun, Qget_file_char)) + if (load_force_doc_strings + && (EQ (readcharfun, Qget_file_char) + || EQ (readcharfun, Qget_emacs_mule_file_char))) { /* If we are supposed to force doc strings into core right now, record the last string that we skipped, @@ -2371,6 +2524,7 @@ read1 (readcharfun, pch, first_in_list) c = READCHAR; } + load_each_byte = 0; goto retry; } if (c == '!') @@ -2506,7 +2660,7 @@ read1 (readcharfun, pch, first_in_list) case '?': { - int discard; + int modifiers; int next_char; int ok; @@ -2522,9 +2676,12 @@ read1 (readcharfun, pch, first_in_list) return make_number (c); if (c == '\\') - c = read_escape (readcharfun, 0, &discard); - else if (BASE_LEADING_CODE_P (c)) - c = read_multibyte (c, readcharfun); + c = read_escape (readcharfun, 0); + modifiers = c & CHAR_MODIFIER_MASK; + c &= ~CHAR_MODIFIER_MASK; + if (CHAR_BYTE8_P (c)) + c = CHAR_TO_BYTE8 (c); + c |= modifiers; next_char = READCHAR; if (next_char == '.') @@ -2559,14 +2716,12 @@ read1 (readcharfun, pch, first_in_list) char *p = read_buffer; char *end = read_buffer + read_buffer_size; register int c; - /* 1 if we saw an escape sequence specifying - a multibyte character, or a multibyte character. */ + /* Nonzero if we saw an escape sequence specifying + a multibyte character. */ int force_multibyte = 0; - /* 1 if we saw an escape sequence specifying + /* Nonzero if we saw an escape sequence specifying a single-byte character. */ int force_singlebyte = 0; - /* 1 if read_buffer contains multibyte text now. */ - int is_multibyte = 0; int cancel = 0; int nchars = 0; @@ -2584,9 +2739,9 @@ read1 (readcharfun, pch, first_in_list) if (c == '\\') { - int byterep; + int modifiers; - c = read_escape (readcharfun, 1, &byterep); + c = read_escape (readcharfun, 1); /* C is -1 if \ newline has just been seen */ if (c == -1) @@ -2596,50 +2751,55 @@ read1 (readcharfun, pch, first_in_list) continue; } - if (byterep == 1) + modifiers = c & CHAR_MODIFIER_MASK; + c = c & ~CHAR_MODIFIER_MASK; + + if (CHAR_BYTE8_P (c)) force_singlebyte = 1; - else if (byterep == 2) + else if (! ASCII_CHAR_P (c)) force_multibyte = 1; - } - - /* A character that must be multibyte forces multibyte. */ - if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK)) - force_multibyte = 1; + else /* i.e. ASCII_CHAR_P (c) */ + { + /* Allow `\C- ' and `\C-?'. */ + if (modifiers == CHAR_CTL) + { + if (c == ' ') + c = 0, modifiers = 0; + else if (c == '?') + c = 127, modifiers = 0; + } + if (modifiers & CHAR_SHIFT) + { + /* Shift modifier is valid only with [A-Za-z]. */ + if (c >= 'A' && c <= 'Z') + modifiers &= ~CHAR_SHIFT; + else if (c >= 'a' && c <= 'z') + c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT; + } + + if (modifiers & CHAR_META) + { + /* Move the meta bit to the right place for a + string. */ + modifiers &= ~CHAR_META; + c = BYTE8_TO_CHAR (c | 0x80); + force_singlebyte = 1; + } + } - /* If we just discovered the need to be multibyte, - convert the text accumulated thus far. */ - if (force_multibyte && ! is_multibyte) - { - is_multibyte = 1; - to_multibyte (&p, &end, &nchars); + /* Any modifiers remaining are invalid. */ + if (modifiers) + error ("Invalid modifier in string"); + p += CHAR_STRING (c, (unsigned char *) p); } - - /* Allow `\C- ' and `\C-?'. */ - if (c == (CHAR_CTL | ' ')) - c = 0; - else if (c == (CHAR_CTL | '?')) - c = 127; - - if (c & CHAR_SHIFT) + else { - /* Shift modifier is valid only with [A-Za-z]. */ - if ((c & 0377) >= 'A' && (c & 0377) <= 'Z') - c &= ~CHAR_SHIFT; - else if ((c & 0377) >= 'a' && (c & 0377) <= 'z') - c = (c & ~CHAR_SHIFT) - ('a' - 'A'); + p += CHAR_STRING (c, (unsigned char *) p); + if (CHAR_BYTE8_P (c)) + force_singlebyte = 1; + else if (! ASCII_CHAR_P (c)) + force_multibyte = 1; } - - if (c & CHAR_META) - /* Move the meta bit to the right place for a string. */ - c = (c & ~CHAR_META) | 0x80; - if (c & CHAR_MODIFIER_MASK) - error ("Invalid modifier in string"); - - if (is_multibyte) - p += CHAR_STRING (c, p); - else - *p++ = c; - nchars++; } @@ -2652,37 +2812,16 @@ read1 (readcharfun, pch, first_in_list) if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel) return make_number (0); - if (is_multibyte || force_singlebyte) + if (force_multibyte) + /* READ_BUFFER already contains valid multibyte forms. */ ; - else if (load_convert_to_unibyte) - { - Lisp_Object string; - to_multibyte (&p, &end, &nchars); - if (p - read_buffer != nchars) - { - string = make_multibyte_string (read_buffer, nchars, - p - read_buffer); - return Fstring_make_unibyte (string); - } - /* We can make a unibyte string directly. */ - is_multibyte = 0; - } - else if (EQ (readcharfun, Qget_file_char) - || EQ (readcharfun, Qlambda)) + else if (force_singlebyte) { - /* Nowadays, reading directly from a file is used only for - compiled Emacs Lisp files, and those always use the - Emacs internal encoding. Meanwhile, Qlambda is used - for reading dynamic byte code (compiled with - byte-compile-dynamic = t). So make the string multibyte - if the string contains any multibyte sequences. - (to_multibyte is a no-op if not.) */ - to_multibyte (&p, &end, &nchars); - is_multibyte = (p - read_buffer) != nchars; + nchars = str_as_unibyte (read_buffer, p - read_buffer); + p = read_buffer + nchars; } else - /* In all other cases, if we read these bytes as - separate characters, treat them as separate characters now. */ + /* Otherwise, READ_BUFFER contains only ASCII. */ ; /* We want readchar_count to be the number of characters, not @@ -2692,9 +2831,11 @@ read1 (readcharfun, pch, first_in_list) /* readchar_count -= (p - read_buffer) - nchars; */ if (read_pure) return make_pure_string (read_buffer, nchars, p - read_buffer, - is_multibyte); + (force_multibyte + || (p - read_buffer != nchars))); return make_specified_string (read_buffer, nchars, p - read_buffer, - is_multibyte); + (force_multibyte + || (p - read_buffer != nchars))); } case '.': @@ -2752,11 +2893,10 @@ read1 (readcharfun, pch, first_in_list) quoted = 1; } - if (! SINGLE_BYTE_CHAR_P (c)) + if (multibyte) p += CHAR_STRING (c, p); else *p++ = c; - c = READCHAR; } @@ -2790,6 +2930,8 @@ read1 (readcharfun, pch, first_in_list) { if (p1[-1] == '.') p1[-1] = '\0'; + /* Fixme: if we have strtol, use that, and check + for overflow. */ if (sizeof (int) == sizeof (EMACS_INT)) XSETINT (val, atoi (read_buffer)); else if (sizeof (long) == sizeof (EMACS_INT)) @@ -2850,8 +2992,19 @@ read1 (readcharfun, pch, first_in_list) } } { - Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer) - : intern (read_buffer); + Lisp_Object name, result; + EMACS_INT nbytes = p - read_buffer; + EMACS_INT nchars + = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes) + : nbytes); + + if (uninterned_symbol && ! NILP (Vpurify_flag)) + name = make_pure_string (read_buffer, nchars, nbytes, multibyte); + else + name = make_specified_string (read_buffer, nchars, nbytes,multibyte); + result = (uninterned_symbol ? Fmake_symbol (name) + : Fintern (name, Qnil)); + if (EQ (Vread_with_symbol_positions, Qt) || EQ (Vread_with_symbol_positions, readcharfun)) Vread_symbol_positions_list = @@ -3110,7 +3263,7 @@ read_vector (readcharfun, bytecodeflag) STRING_SET_CHARS (bytestr, SBYTES (bytestr)); STRING_SET_UNIBYTE (bytestr); - item = Fread (bytestr); + item = Fread (Fcons (bytestr, readcharfun)); if (!CONSP (item)) error ("Invalid byte code"); @@ -3123,6 +3276,15 @@ read_vector (readcharfun, bytecodeflag) /* Now handle the bytecode slot. */ ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr; } + else if (i == COMPILED_DOC_STRING + && STRINGP (item) + && ! STRING_MULTIBYTE (item)) + { + if (EQ (readcharfun, Qget_emacs_mule_file_char)) + item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil); + else + item = Fstring_as_multibyte (item); + } } ptr[i] = read_pure ? Fpurecopy (item) : item; otem = XCONS (tem); @@ -3219,7 +3381,15 @@ read_list (flag, readcharfun) if (doc_reference == 2) { /* Get a doc string from the file we are loading. - If it's in saved_doc_string, get it from there. */ + If it's in saved_doc_string, get it from there. + + Here, we don't know if the string is a + bytecode string or a doc string. As a + bytecode string must be unibyte, we always + return a unibyte string. If it is actually a + doc string, caller must make it + multibyte. */ + int pos = XINT (XCDR (val)); /* Position is negative for user variables. */ if (pos < 0) pos = -pos; @@ -3251,8 +3421,8 @@ read_list (flag, readcharfun) saved_doc_string[to++] = c; } - return make_string (saved_doc_string + start, - to - start); + return make_unibyte_string (saved_doc_string + start, + to - start); } /* Look in prev_saved_doc_string the same way. */ else if (pos >= prev_saved_doc_string_position @@ -3283,11 +3453,12 @@ read_list (flag, readcharfun) prev_saved_doc_string[to++] = c; } - return make_string (prev_saved_doc_string + start, - to - start); + return make_unibyte_string (prev_saved_doc_string + + start, + to - start); } else - return get_doc_string (val, 0, 0); + return get_doc_string (val, 1, 0); } return val; @@ -4208,6 +4379,12 @@ to load. See also `load-dangerous-libraries'. */); Qget_file_char = intern ("get-file-char"); staticpro (&Qget_file_char); + Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char"); + staticpro (&Qget_emacs_mule_file_char); + + Qload_force_doc_strings = intern ("load-force-doc-strings"); + staticpro (&Qload_force_doc_strings); + Qbackquote = intern ("`"); staticpro (&Qbackquote); Qcomma = intern (","); diff --git a/src/macfns.c b/src/macfns.c index 7afeaafd85b..1b2c2d5702a 100644 --- a/src/macfns.c +++ b/src/macfns.c @@ -2654,7 +2654,7 @@ This function is an internal primitive--use `make-frame' instead. */) { tem = Fquery_fontset (font, Qnil); if (STRINGP (tem)) - font = x_new_fontset (f, SDATA (tem)); + font = x_new_fontset (f, tem); else font = x_new_font (f, SDATA (font)); } @@ -2667,7 +2667,7 @@ This function is an internal primitive--use `make-frame' instead. */) font = x_new_font (f, "-ETL-fixed-medium-r-*--*-160-*-*-*-*-iso8859-1"); /* If those didn't work, look for something which will at least work. */ if (! STRINGP (font)) - font = x_new_fontset (f, "fontset-standard"); + font = x_new_fontset (f, build_string ("fontset-standard")); if (! STRINGP (font)) font = x_new_font (f, "-*-monaco-*-12-*-mac-roman"); if (! STRINGP (font)) @@ -3881,7 +3881,7 @@ x_create_tip_frame (dpyinfo, parms, text) { tem = Fquery_fontset (font, Qnil); if (STRINGP (tem)) - font = x_new_fontset (f, SDATA (tem)); + font = x_new_fontset (f, tem); else font = x_new_font (f, SDATA (font)); } @@ -3895,7 +3895,7 @@ x_create_tip_frame (dpyinfo, parms, text) font = x_new_font (f, "-ETL-fixed-medium-r-*--*-160-*-*-*-*-iso8859-1"); /* If those didn't work, look for something which will at least work. */ if (! STRINGP (font)) - font = x_new_fontset (f, "fontset-standard"); + font = x_new_fontset (f, build_string ("fontset-standard")); if (! STRINGP (font)) font = x_new_font (f, "-*-monaco-*-12-*-mac-roman"); if (! STRINGP (font)) diff --git a/src/macgui.h b/src/macgui.h index 7a65e583b1b..3e3fed77c11 100644 --- a/src/macgui.h +++ b/src/macgui.h @@ -81,11 +81,13 @@ typedef unsigned long Time; /* Whether to use ATSUI (Apple Type Services for Unicode Imaging) for text drawing. */ +#if 0 /* Don't enable by default on the emacs-unicode-2 branch. */ #ifndef USE_ATSUI #ifdef MAC_OSX #define USE_ATSUI 1 #endif #endif +#endif /* Whether to use low-level Quartz 2D (aka Core Graphics) text drawing in preference to ATSUI for ASCII and Latin-1 characters. */ diff --git a/src/macterm.c b/src/macterm.c index 1bf0cd0e707..f07b9eb0a5d 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -80,6 +80,8 @@ Boston, MA 02110-1301, USA. */ #include "intervals.h" #include "atimer.h" #include "keymap.h" +#include "character.h" +#include "ccl.h" @@ -2421,7 +2423,8 @@ XTreset_terminal_modes (struct terminal *t) /* Function prototypes of this page. */ static XCharStruct *x_per_char_metric P_ ((XFontStruct *, XChar2b *)); -static int mac_encode_char P_ ((int, XChar2b *, struct font_info *, int *)); +static int mac_encode_char P_ ((int, XChar2b *, struct font_info *, + struct charset *, int *)); static void @@ -2565,13 +2568,13 @@ mac_per_char_metric (font, char2b, font_type) the two-byte form of C. Encoding is returned in *CHAR2B. */ static int -mac_encode_char (c, char2b, font_info, two_byte_p) +mac_encode_char (c, char2b, font_info, charset, two_byte_p) int c; XChar2b *char2b; struct font_info *font_info; + struct charset *charset; int *two_byte_p; { - int charset = CHAR_CHARSET (c); XFontStruct *font = font_info->font; /* FONT_INFO may define a scheme by which to encode byte1 and byte2. @@ -2585,31 +2588,31 @@ mac_encode_char (c, char2b, font_info, two_byte_p) check_ccl_update (ccl); if (CHARSET_DIMENSION (charset) == 1) { - ccl->reg[0] = charset; - ccl->reg[1] = char2b->byte2; + ccl->reg[0] = CHARSET_ID (charset); + ccl->reg[1] = XCHAR2B_BYTE2 (char2b); ccl->reg[2] = -1; } else { - ccl->reg[0] = charset; - ccl->reg[1] = char2b->byte1; - ccl->reg[2] = char2b->byte2; + ccl->reg[0] = CHARSET_ID (charset); + ccl->reg[1] = XCHAR2B_BYTE1 (char2b); + ccl->reg[2] = XCHAR2B_BYTE2 (char2b); } - ccl_driver (ccl, NULL, NULL, 0, 0, NULL); + ccl_driver (ccl, NULL, NULL, 0, 0, Qnil); /* We assume that MSBs are appropriately set/reset by CCL program. */ if (font->max_byte1 == 0) /* 1-byte font */ - char2b->byte1 = 0, char2b->byte2 = ccl->reg[1]; + STORE_XCHAR2B (char2b, 0, ccl->reg[1]); else - char2b->byte1 = ccl->reg[1], char2b->byte2 = ccl->reg[2]; + STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]); } - else if (font_info->encoding[charset]) + else if (font_info->encoding_type) { /* Fixed encoding scheme. See fontset.h for the meaning of the encoding numbers. */ - int enc = font_info->encoding[charset]; + unsigned char enc = font_info->encoding_type; if ((enc == 1 || enc == 2) && CHARSET_DIMENSION (charset) == 2) @@ -2619,13 +2622,12 @@ mac_encode_char (c, char2b, font_info, two_byte_p) char2b->byte2 |= 0x80; if (enc == 4) - { - int sjis1, sjis2; + { + int code = (char2b->byte1 << 8) | char2b->byte2; - ENCODE_SJIS (char2b->byte1, char2b->byte2, sjis1, sjis2); - char2b->byte1 = sjis1; - char2b->byte2 = sjis2; - } + JIS_TO_SJIS (code); + STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); + } } if (two_byte_p) @@ -2744,9 +2746,9 @@ x_set_mouse_face_gc (s) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch); + face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); else - face_id = FACE_FOR_CHAR (s->f, face, 0); + face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); s->face = FACE_FROM_ID (s->f, face_id); PREPARE_FACE_FOR_DISPLAY (s->f, s->face); @@ -3109,8 +3111,8 @@ x_frame_of_widget (widget) /* Look for a frame with that top-level widget. Allocate the color on that frame to get the right gamma correction value. */ - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) - if (GC_FRAMEP (XCAR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) + if (FRAMEP (XCAR (tail)) && (f = XFRAME (XCAR (tail)), (f->output_data.nothing != 1 && FRAME_X_DISPLAY_INFO (f) == dpyinfo)) @@ -4418,9 +4420,9 @@ mac_focus_changed (type, dpyinfo, frame, bufp) /* Don't stop displaying the initial startup message for a switch-frame event we don't need. */ - if (GC_NILP (Vterminal_frame) - && GC_CONSP (Vframe_list) - && !GC_NILP (XCDR (Vframe_list))) + if (NILP (Vterminal_frame) + && CONSP (Vframe_list) + && !NILP (XCDR (Vframe_list))) { bufp->kind = FOCUS_IN_EVENT; XSETFRAME (bufp->frame_or_window, frame); @@ -4493,7 +4495,7 @@ x_frame_rehighlight (dpyinfo) if (dpyinfo->x_focus_frame) { dpyinfo->x_highlight_frame - = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame))) + = ((FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame))) ? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame)) : dpyinfo->x_focus_frame); if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame)) @@ -5523,7 +5525,7 @@ x_scroll_bar_handle_click (bar, part_code, er, bufp) { int win_y, top_range; - if (! GC_WINDOWP (bar->window)) + if (! WINDOWP (bar->window)) abort (); bufp->kind = SCROLL_BAR_CLICK_EVENT; @@ -5598,7 +5600,7 @@ x_scroll_bar_note_movement (bar, y_pos, t) XSETVECTOR (last_mouse_scroll_bar, bar); /* If we're dragging the bar, display it. */ - if (! GC_NILP (bar->dragging)) + if (! NILP (bar->dragging)) { /* Where should the handle be now? */ int new_start = y_pos - 24; @@ -6557,11 +6559,16 @@ x_new_font (f, fontname) register char *fontname; { struct font_info *fontp - = FS_LOAD_FONT (f, 0, fontname, -1); + = FS_LOAD_FONT (f, fontname); if (!fontp) return Qnil; + if (FRAME_FONT (f) == (XFontStruct *) (fontp->font)) + /* This font is already set in frame F. There's nothing more to + do. */ + return build_string (fontp->full_name); + FRAME_FONT (f) = (XFontStruct *) (fontp->font); FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset; FRAME_FONTSET (f) = -1; @@ -6604,38 +6611,50 @@ x_new_font (f, fontname) return build_string (fontp->full_name); } + +/* Give frame F the fontset named FONTSETNAME as its default fontset, + and return the full name of that fontset. FONTSETNAME may be a + wildcard pattern; in that case, we choose some fontset that fits + the pattern. FONTSETNAME may be a font name for ASCII characters; + in that case, we create a fontset from that font name. -/* Give frame F the fontset named FONTSETNAME as its default font, and - return the full name of that fontset. FONTSETNAME may be a wildcard - pattern; in that case, we choose some fontset that fits the pattern. - The return value shows which fontset we chose. */ + The return value shows which fontset we chose. + If FONTSETNAME specifies the default fontset, return Qt. + If an ASCII font in the specified fontset can't be loaded, return + Qnil. */ Lisp_Object x_new_fontset (f, fontsetname) struct frame *f; - char *fontsetname; + Lisp_Object fontsetname; { - int fontset = fs_query_fontset (build_string (fontsetname), 0); + int fontset = fs_query_fontset (fontsetname, 0); Lisp_Object result; - if (fontset < 0) - return Qnil; - - if (FRAME_FONTSET (f) == fontset) + if (fontset > 0 && FRAME_FONTSET(f) == fontset) /* This fontset is already set in frame F. There's nothing more to do. */ return fontset_name (fontset); + else if (fontset == 0) + /* The default fontset can't be the default font. */ + return Qt; - result = x_new_font (f, (SDATA (fontset_ascii (fontset)))); + if (fontset > 0) + result = x_new_font (f, (SDATA (fontset_ascii (fontset)))); + else + result = x_new_font (f, SDATA (fontsetname)); if (!STRINGP (result)) /* Can't load ASCII font. */ return Qnil; + if (fontset < 0) + fontset = new_fontset_from_font_name (result); + /* Since x_new_font doesn't update any fontset information, do it now. */ FRAME_FONTSET (f) = fontset; - return build_string (fontsetname); + return fontset_name (fontset); } @@ -7849,12 +7868,12 @@ decode_mac_font_name (name, size, coding_system) coding.src_multibyte = 0; coding.dst_multibyte = 1; coding.mode |= CODING_MODE_LAST_BLOCK; - coding.composing = COMPOSITION_DISABLED; - buf = (char *) alloca (size); + coding.dst_bytes = size; + coding.destination = (unsigned char *) alloca (coding.dst_bytes); - decode_coding (&coding, name, buf, strlen (name), size - 1); - bcopy (buf, name, coding.produced); - name[coding.produced] = '\0'; + decode_coding_c_string (&coding, name, strlen (name), Qnil); + bcopy (coding.destination, name, min (coding.produced, size)); + name[min (coding.produced, size)] = '\0'; } } @@ -9191,6 +9210,7 @@ x_load_font (f, fontname, size) bzero (fontp, sizeof (*fontp)); fontp->font = font; fontp->font_idx = i; + fontp->charset = -1; /* fs_load_font sets it. */ fontp->name = (char *) xmalloc (strlen (fontname) + 1); bcopy (fontname, fontp->name, strlen (fontname) + 1); @@ -9236,19 +9256,20 @@ x_load_font (f, fontname, size) fontp->height = max_height; } + /* MAC_TODO: The script encoding is irrelevant in unicode? */ /* The slot `encoding' specifies how to map a character code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, 2:0xA020..0xFF7F). For the moment, we don't know which charset - uses this font. So, we set information in fontp->encoding[1] + uses this font. So, we set information in fontp->encoding_type which is never used by any charset. If mapping can't be decided, set FONT_ENCODING_NOT_DECIDED. */ if (font->mac_scriptcode == smJapanese) - fontp->encoding[1] = 4; + fontp->encoding_type = 4; else { - fontp->encoding[1] + fontp->encoding_type = (font->max_byte1 == 0 /* 1-byte font */ ? (font->min_char_or_byte2 < 0x80 diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 65c5d87b845..4242f35eb3b 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -117,6 +117,8 @@ OBJ1 = $(BLD)/alloc.$(O) \ $(BLD)/region-cache.$(O) \ $(BLD)/strftime.$(O) \ $(BLD)/charset.$(O) \ + $(BLD)/character.$(O) \ + $(BLD)/chartab.$(O) \ $(BLD)/coding.$(O) \ $(BLD)/category.$(O) \ $(BLD)/ccl.$(O) \ @@ -125,6 +127,7 @@ OBJ1 = $(BLD)/alloc.$(O) \ $(BLD)/image.$(O) \ $(BLD)/terminal.$(O) + WIN32OBJ = $(BLD)/w32term.$(O) \ $(BLD)/w32xfns.$(O) \ $(BLD)/w32fns.$(O) \ @@ -134,6 +137,12 @@ WIN32OBJ = $(BLD)/w32term.$(O) \ $(BLD)/w32reg.$(O) \ $(BLD)/w32bdf.$(O) +FONTOBJ = +ifdef USE_FONTBACKEND +FONTOBJ = $(BLD)/font.$(O) \ + $(BLD)/w32font.$(O) +endif + LIBS = $(TLIB0) \ $(TLIB1) \ $(TLIBW32) \ @@ -173,10 +182,11 @@ temacs: stamp_BLD $(TEMACS) $(TEMACS): $(TLIB0) $(TLIB1) $(TLIBW32) $(TLASTLIB) $(TOBJ) $(TRES) \ ../nt/$(BLD)/addsection.exe $(LINK) $(LINK_OUT)$(TEMACS_TMP) $(FULL_LINK_FLAGS) $(TOBJ) $(TRES) $(LIBS) - "../nt/$(BLD)/addsection" "$(TEMACS_TMP)" "$(TEMACS)" EMHEAP 16 + "../nt/$(BLD)/addsection" "$(TEMACS_TMP)" "$(TEMACS)" EMHEAP 20 echo $(OBJ0) > $(BLD)/buildobj.lst echo $(OBJ1) >> $(BLD)/buildobj.lst echo $(WIN32OBJ) >> $(BLD)/buildobj.lst + echo $(FONTOBJ) >> $(BLD)/buildobj.lst bootstrap: bootstrap-emacs @@ -225,7 +235,7 @@ $(TLIB0): $(OBJ0) $(TLIB1): $(OBJ1) - $(DEL) $@ $(AR) $(AR_OUT)$@ $(ALL_DEPS) -$(TLIBW32): $(WIN32OBJ) +$(TLIBW32): $(WIN32OBJ) $(FONTOBJ) - $(DEL) $@ $(AR) $(AR_OUT)$@ $(ALL_DEPS) @@ -270,6 +280,21 @@ cleanall: clean EMACS_ROOT = .. SRC = . +$(BLD)/abbrev.$(O) : \ + $(SRC)/abbrev.c \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h \ + $(SRC)/buffer.h \ + $(SRC)/character.h \ + $(SRC)/charset.h \ + $(SRC)/commands.h \ + $(SRC)/dispextern.h \ + $(SRC)/syntax.h \ + $(SRC)/w32bdf.h \ + $(SRC)/w32gui.h \ + $(SRC)/window.h + $(BLD)/alloc.$(O) : \ $(SRC)/alloc.c \ $(EMACS_ROOT)/src/s/ms-w32.h \ @@ -277,6 +302,7 @@ $(BLD)/alloc.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ @@ -359,6 +385,7 @@ $(BLD)/callproc.$(O) : \ $(EMACS_ROOT)/nt/inc/sys/file.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/commands.h \ @@ -377,6 +404,7 @@ $(BLD)/casefiddle.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ @@ -398,6 +426,7 @@ $(BLD)/category.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ $(SRC)/category.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/keymap.h @@ -407,9 +436,22 @@ $(BLD)/ccl.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h +$(BLD)/character.$(O) : \ + $(SRC)/character.c \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h \ + $(SRC)/buffer.h \ + $(SRC)/character.h \ + $(SRC)/charset.h \ + $(SRC)/coding.h \ + $(SRC)/composite.h \ + $(SRC)/disptab.h + $(BLD)/charset.$(O) : \ $(SRC)/charset.c \ $(EMACS_ROOT)/src/s/ms-w32.h \ @@ -417,11 +459,20 @@ $(BLD)/charset.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/composite.h \ $(SRC)/disptab.h +$(BLD)/chartab.$(O) : \ + $(SRC)/chartab.c \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h \ + $(SRC)/charset.h \ + $(SRC)/character.h + $(BLD)/cm.$(O) : \ $(SRC)/cm.c \ $(EMACS_ROOT)/src/s/ms-w32.h \ @@ -436,6 +487,7 @@ $(BLD)/cmds.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/commands.h \ $(SRC)/dispextern.h \ @@ -453,6 +505,7 @@ $(BLD)/coding.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/composite.h \ @@ -470,6 +523,7 @@ $(BLD)/composite.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ @@ -483,6 +537,7 @@ $(BLD)/data.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/frame.h \ $(SRC)/keyboard.h \ @@ -497,6 +552,7 @@ $(BLD)/dired.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/commands.h \ @@ -514,6 +570,7 @@ $(BLD)/dispnew.$(O) : \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/cm.h \ $(SRC)/commands.h \ @@ -542,6 +599,7 @@ $(BLD)/doc.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(EMACS_ROOT)/nt/inc/sys/file.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/keyboard.h \ $(SRC)/keymap.h @@ -551,6 +609,7 @@ $(BLD)/doprnt.$(O) : \ $(EMACS_ROOT)/src/s/ms-w32.h \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ + $(SRC)/character.h \ $(SRC)/charset.c $(BLD)/editfns.$(O) : \ @@ -561,6 +620,7 @@ $(BLD)/editfns.$(O) : \ $(EMACS_ROOT)/nt/inc/pwd.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/composite.h \ @@ -622,6 +682,7 @@ $(BLD)/fileio.$(O) : \ $(EMACS_ROOT)/nt/inc/sys/file.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/commands.h \ @@ -643,6 +704,7 @@ $(BLD)/filelock.$(O) : \ $(EMACS_ROOT)/src/epaths.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/systime.h @@ -680,6 +742,7 @@ $(BLD)/fns.$(O) : \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/commands.h \ @@ -696,6 +759,19 @@ $(BLD)/fns.$(O) : \ $(SRC)/w32gui.h \ $(SRC)/window.h +$(BLD)/font.$(O) : \ + $(SRC)/font.c \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h \ + $(SRC)/dispextern.h \ + $(SRC)/frame.h \ + $(SRC)/window.h \ + $(SRC)/ccl.h \ + $(SRC)/character.h \ + $(SRC)/charset.h \ + $(SRC)/font.h + $(BLD)/fontset.$(O) : \ $(SRC)/fontset.c \ $(EMACS_ROOT)/src/s/ms-w32.h \ @@ -703,8 +779,10 @@ $(BLD)/fontset.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/dispextern.h \ + $(SRC)/font.h \ $(SRC)/fontset.h \ $(SRC)/frame.h \ $(SRC)/keyboard.h \ @@ -721,6 +799,7 @@ $(BLD)/frame.$(O) : \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/commands.h \ $(SRC)/dispextern.h \ @@ -783,6 +862,7 @@ $(BLD)/indent.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ $(SRC)/category.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ @@ -806,6 +886,7 @@ $(BLD)/insdel.$(O) : \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ @@ -841,6 +922,7 @@ $(BLD)/keyboard.$(O) : \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ @@ -872,6 +954,7 @@ $(BLD)/keymap.$(O) : \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ @@ -901,6 +984,7 @@ $(BLD)/lread.$(O) : \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/commands.h \ @@ -932,6 +1016,7 @@ $(BLD)/marker.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h $(BLD)/md5.$(O) : \ @@ -944,6 +1029,7 @@ $(BLD)/minibuf.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ @@ -999,6 +1085,7 @@ $(BLD)/w32proc.$(O) : \ $(EMACS_ROOT)/nt/inc/langinfo.h \ $(EMACS_ROOT)/nt/inc/nl_types.h \ $(SRC)/config.h \ + $(SRC)/character.h \ $(SRC)/process.h \ $(SRC)/syssignal.h \ $(SRC)/systime.h \ @@ -1014,6 +1101,7 @@ $(BLD)/w32console.$(O) : \ $(SRC)/s/ms-w32.h \ $(SRC)/m/intel386.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/config.h \ @@ -1031,6 +1119,7 @@ $(BLD)/print.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ @@ -1054,6 +1143,7 @@ $(BLD)/process.$(O) : \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/commands.h \ @@ -1093,6 +1183,7 @@ $(BLD)/regex.$(O) : \ $(SRC)/m/intel386.h \ $(SRC)/buffer.h \ $(SRC)/category.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/config.h \ $(SRC)/regex.h \ @@ -1129,6 +1220,7 @@ $(BLD)/search.$(O) : \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/category.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ @@ -1161,6 +1253,7 @@ $(BLD)/syntax.$(O) : \ $(EMACS_ROOT)/src/config.h \ $(SRC)/buffer.h \ $(SRC)/category.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ @@ -1206,6 +1299,7 @@ $(BLD)/term.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/cm.h \ $(SRC)/coding.h \ @@ -1314,12 +1408,14 @@ $(BLD)/xdisp.$(O) : \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ $(SRC)/disptab.h \ + $(SRC)/font.h \ $(SRC)/fontset.h \ $(SRC)/frame.h \ $(SRC)/indent.h \ @@ -1345,9 +1441,11 @@ $(BLD)/xfaces.$(O): \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ + $(SRC)/font.h \ $(SRC)/fontset.h \ $(SRC)/frame.h \ $(SRC)/intervals.h \ @@ -1369,11 +1467,13 @@ $(BLD)/w32fns.$(O): \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ $(SRC)/epaths.h \ + $(SRC)/font.h \ $(SRC)/fontset.h \ $(SRC)/frame.h \ $(SRC)/intervals.h \ @@ -1394,6 +1494,7 @@ $(BLD)/w32menu.$(O): \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/dispextern.h \ @@ -1416,11 +1517,13 @@ $(BLD)/w32term.$(O): \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/composite.h \ $(SRC)/dispextern.h \ $(SRC)/disptab.h \ + $(SRC)/font.h \ $(SRC)/fontset.h \ $(SRC)/frame.h \ $(SRC)/gnu.h \ @@ -1447,6 +1550,7 @@ $(BLD)/w32select.$(O): \ $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/coding.h \ $(SRC)/composite.h \ @@ -1478,6 +1582,7 @@ $(BLD)/w32xfns.$(O): \ $(EMACS_ROOT)/src/config.h \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/fontset.h \ $(SRC)/frame.h \ @@ -1494,6 +1599,7 @@ $(BLD)/w32bdf.$(O): \ $(EMACS_ROOT)/src/config.h \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ + $(SRC)/character.h \ $(SRC)/charset.h \ $(SRC)/dispextern.h \ $(SRC)/fontset.h \ @@ -1504,7 +1610,22 @@ $(BLD)/w32bdf.$(O): \ $(SRC)/w32gui.h \ $(SRC)/w32term.h +$(BLD)/w32font$(O): \ + $(SRC)/w32font.c \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h \ + $(SRC)/character.h \ + $(SRC)/charset.h \ + $(SRC)/dispextern.h \ + $(SRC)/font.h \ + $(SRC)/fontset.h \ + $(SRC)/frame.h \ + $(SRC)/w32font.h \ + $(SRC)/w32gui.h \ + $(SRC)/w32term.h + # Each object file depends on stamp_BLD, because in parallel builds we must # make sure $(BLD) exists before starting compilations. # -$(OBJ0) $(OBJ1) $(WIN32OBJ) $(BLD)/lastfile.$(O) $(BLD)/firstfile.$(O): stamp_BLD +$(OBJ0) $(OBJ1) $(WIN32OBJ) $(FONTOBJ) $(BLD)/lastfile.$(O) $(BLD)/firstfile.$(O): stamp_BLD diff --git a/src/marker.c b/src/marker.c index 0c89f71d79a..d054ef91e79 100644 --- a/src/marker.c +++ b/src/marker.c @@ -23,7 +23,7 @@ Boston, MA 02110-1301, USA. */ #include <config.h> #include "lisp.h" #include "buffer.h" -#include "charset.h" +#include "character.h" /* Record one cached position found recently by buf_charpos_to_bytepos or buf_bytepos_to_charpos. */ diff --git a/src/minibuf.c b/src/minibuf.c index 5cd821e5179..812956a13ca 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -27,7 +27,7 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "commands.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "dispextern.h" #include "keyboard.h" #include "frame.h" @@ -2432,23 +2432,14 @@ Return nil if there is no valid completion, else t. */) /* Now find first word-break in the stuff found by completion. i gets index in string of where to stop completing. */ - { - int len, c; - int bytes = SBYTES (completion); - register const unsigned char *completion_string = SDATA (completion); - for (; i_byte < SBYTES (completion); i_byte += len, i++) - { - c = STRING_CHAR_AND_LENGTH (completion_string + i_byte, - bytes - i_byte, - len); - if (SYNTAX (c) != Sword) - { - i_byte += len; - i++; - break; - } - } - } + while (i_byte < SBYTES (completion)) + { + int c; + + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, completion, i, i_byte); + if (SYNTAX (c) != Sword) + break; + } /* If got no characters, print help for user. */ @@ -2728,7 +2719,7 @@ DEFUN ("self-insert-and-exit", Fself_insert_and_exit, Sself_insert_and_exit, 0, doc: /* Terminate minibuffer input. */) () { - if (INTEGERP (last_command_char)) + if (CHARACTERP (last_command_char)) internal_self_insert (XINT (last_command_char), 0); else bitch_at_user (); diff --git a/src/msdos.c b/src/msdos.c index fc14be2705c..2e3ce3cf146 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -56,7 +56,7 @@ Boston, MA 02110-1301, USA. */ #include "dispextern.h" #include "dosfns.h" #include "termopts.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "disptab.h" #include "frame.h" @@ -3799,15 +3799,15 @@ XMenuActivate (Display *foo, XMenu *menu, int *pane, int *selidx, screensize = screen_size * 2; faces[0] = lookup_derived_face (sf, intern ("msdos-menu-passive-face"), - 0, DEFAULT_FACE_ID, 1); + DEFAULT_FACE_ID, 1); faces[1] = lookup_derived_face (sf, intern ("msdos-menu-active-face"), - 0, DEFAULT_FACE_ID, 1); + DEFAULT_FACE_ID, 1); selectface = intern ("msdos-menu-select-face"); faces[2] = lookup_derived_face (sf, selectface, - 0, faces[0], 1); + faces[0], 1); faces[3] = lookup_derived_face (sf, selectface, - 0, faces[1], 1); + faces[1], 1); /* Make sure the menu title is always displayed with `msdos-menu-active-face', no matter where the mouse pointer is. */ diff --git a/src/print.c b/src/print.c index 3a2e6926729..a88404cb52e 100644 --- a/src/print.c +++ b/src/print.c @@ -25,6 +25,7 @@ Boston, MA 02110-1301, USA. */ #include <stdio.h> #include "lisp.h" #include "buffer.h" +#include "character.h" #include "charset.h" #include "keyboard.h" #include "frame.h" @@ -477,11 +478,15 @@ print_string (string, printcharfun) { int chars; + if (print_escape_nonascii) + string = string_escape_byte8 (string); + if (STRING_MULTIBYTE (string)) chars = SCHARS (string); - else if (EQ (printcharfun, Qt) - ? ! NILP (buffer_defaults.enable_multibyte_characters) - : ! NILP (current_buffer->enable_multibyte_characters)) + else if (! print_escape_nonascii + && (EQ (printcharfun, Qt) + ? ! NILP (buffer_defaults.enable_multibyte_characters) + : ! NILP (current_buffer->enable_multibyte_characters))) { /* If unibyte string STRING contains 8-bit codes, we must convert STRING to a multibyte string containing the same @@ -546,11 +551,6 @@ print_string (string, printcharfun) int len; int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, size_byte - i, len); - if (!CHAR_VALID_P (ch, 0)) - { - ch = SREF (string, i); - len = 1; - } PRINTCHAR (ch); i += len; } @@ -1431,7 +1431,7 @@ print_preprocess (obj) print_number_index++; } - switch (XGCTYPE (obj)) + switch (XTYPE (obj)) { case Lisp_String: /* A string may have text properties, which can be circular. */ @@ -1474,6 +1474,93 @@ print_preprocess_string (interval, arg) print_preprocess (interval->plist); } +/* A flag to control printing of `charset' text property. + The default value is Qdefault. */ +Lisp_Object Vprint_charset_text_property; +extern Lisp_Object Qdefault; + +static void print_check_string_charset_prop (); + +#define PRINT_STRING_NON_CHARSET_FOUND 1 +#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2 + +/* Bitwize or of the abobe macros. */ +static int print_check_string_result; + +static void +print_check_string_charset_prop (interval, string) + INTERVAL interval; + Lisp_Object string; +{ + Lisp_Object val; + + if (NILP (interval->plist) + || (print_check_string_result == (PRINT_STRING_NON_CHARSET_FOUND + | PRINT_STRING_UNSAFE_CHARSET_FOUND))) + return; + for (val = interval->plist; CONSP (val) && ! EQ (XCAR (val), Qcharset); + val = XCDR (XCDR (val))); + if (! CONSP (val)) + { + print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND; + return; + } + if (! (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)) + { + if (! EQ (val, interval->plist) + || CONSP (XCDR (XCDR (val)))) + print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND; + } + if (NILP (Vprint_charset_text_property) + || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) + { + int i, c; + int charpos = interval->position; + int bytepos = string_char_to_byte (string, charpos); + Lisp_Object charset; + + charset = XCAR (XCDR (val)); + for (i = 0; i < LENGTH (interval); i++) + { + FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos); + if (! ASCII_CHAR_P (c) + && ! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset)) + { + print_check_string_result |= PRINT_STRING_UNSAFE_CHARSET_FOUND; + break; + } + } + } +} + +/* The value is (charset . nil). */ +static Lisp_Object print_prune_charset_plist; + +static Lisp_Object +print_prune_string_charset (string) + Lisp_Object string; +{ + print_check_string_result = 0; + traverse_intervals (STRING_INTERVALS (string), 0, + print_check_string_charset_prop, string); + if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) + { + string = Fcopy_sequence (string); + if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND) + { + if (NILP (print_prune_charset_plist)) + print_prune_charset_plist = Fcons (Qcharset, Qnil); + Fremove_text_properties (make_number (0), + make_number (SCHARS (string)), + print_prune_charset_plist, string); + } + else + Fset_text_properties (make_number (0), make_number (SCHARS (string)), + Qnil, string); + } + return string; +} + static void print_object (obj, printcharfun, escapeflag) Lisp_Object obj; @@ -1486,7 +1573,7 @@ print_object (obj, printcharfun, escapeflag) /* Detect circularities and truncate them. */ if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) - || COMPILEDP (obj) || CHAR_TABLE_P (obj) + || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) && !SYMBOL_INTERNED_P (obj))) @@ -1545,7 +1632,7 @@ print_object (obj, printcharfun, escapeflag) } #endif /* MAX_PRINT_CHARS */ - switch (XGCTYPE (obj)) + switch (XTYPE (obj)) { case Lisp_Int: if (sizeof (int) == sizeof (EMACS_INT)) @@ -1582,6 +1669,9 @@ print_object (obj, printcharfun, escapeflag) GCPRO1 (obj); + if (! EQ (Vprint_charset_text_property, Qt)) + obj = print_prune_string_charset (obj); + if (!NULL_INTERVAL_P (STRING_INTERVALS (obj))) { PRINTCHAR ('#'); @@ -1603,10 +1693,7 @@ print_object (obj, printcharfun, escapeflag) { c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte - i_byte, len); - if (CHAR_VALID_P (c, 0)) - i_byte += len; - else - c = str[i_byte++]; + i_byte += len; } else c = str[i_byte++]; @@ -1624,8 +1711,8 @@ print_object (obj, printcharfun, escapeflag) PRINTCHAR ('f'); } else if (multibyte - && ! ASCII_BYTE_P (c) - && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte)) + && (CHAR_BYTE8_P (c) + || (! ASCII_CHAR_P (c) && print_escape_multibyte))) { /* When multibyte is disabled, print multibyte string chars using hex escapes. @@ -1633,9 +1720,15 @@ print_object (obj, printcharfun, escapeflag) when found in a multibyte string, always use a hex escape so it reads back as multibyte. */ unsigned char outbuf[50]; - sprintf (outbuf, "\\x%x", c); + + if (CHAR_BYTE8_P (c)) + sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c)); + else + { + sprintf (outbuf, "\\x%04x", c); + need_nonhex = 1; + } strout (outbuf, -1, -1, printcharfun, 0); - need_nonhex = 1; } else if (! multibyte && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c) @@ -1924,7 +2017,12 @@ print_object (obj, printcharfun, escapeflag) { QUIT; c = XBOOL_VECTOR (obj)->data[i]; - if (c == '\n' && print_escape_newlines) + if (! ASCII_BYTE_P (c)) + { + sprintf (buf, "\\%03o", c); + strout (buf, -1, -1, printcharfun, 0); + } + else if (c == '\n' && print_escape_newlines) { PRINTCHAR ('\\'); PRINTCHAR ('n'); @@ -2039,7 +2137,7 @@ print_object (obj, printcharfun, escapeflag) PRINTCHAR ('#'); size &= PSEUDOVECTOR_SIZE_MASK; } - if (CHAR_TABLE_P (obj)) + if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)) { /* We print a char-table as if it were a vector, lumping the parent and default slots in with the @@ -2227,6 +2325,8 @@ print_interval (interval, printcharfun) INTERVAL interval; Lisp_Object printcharfun; { + if (NILP (interval->plist)) + return; PRINTCHAR (' '); print_object (make_number (interval->position), printcharfun, 1); PRINTCHAR (' '); @@ -2349,6 +2449,19 @@ the printing done so far has not found any shared structure or objects that need to be recorded in the table. */); Vprint_number_table = Qnil; + DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property, + doc: /* A flag to control printing of `charset' text property on printing a string. +The value must be nil, t, or `default'. + +If the value is nil, don't print the text property `charset'. + +If the value is t, always print the text property `charset'. + +If the value is `default', print the text property `charset' only when +the value is different from what is guessed in the current charset +priorities. */); + Vprint_charset_text_property = Qdefault; + /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ staticpro (&Vprin1_to_string_buffer); @@ -2376,6 +2489,9 @@ that need to be recorded in the table. */); Qprint_escape_nonascii = intern ("print-escape-nonascii"); staticpro (&Qprint_escape_nonascii); + print_prune_charset_plist = Qnil; + staticpro (&print_prune_charset_plist); + defsubr (&Swith_output_to_temp_buffer); } diff --git a/src/process.c b/src/process.c index e285ed4bde0..542bf4fdda5 100644 --- a/src/process.c +++ b/src/process.c @@ -133,7 +133,7 @@ Boston, MA 02110-1301, USA. */ #include "window.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "process.h" #include "frame.h" @@ -174,8 +174,8 @@ extern Lisp_Object QCfilter; Qt nor Qnil but is instead a property list (KEY VAL ...). */ #ifdef HAVE_SOCKETS -#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp)) -#define NETCONN1_P(p) (GC_CONSP ((p)->childp)) +#define NETCONN_P(p) (CONSP (XPROCESS (p)->childp)) +#define NETCONN1_P(p) (CONSP ((p)->childp)) #else #define NETCONN_P(p) 0 #define NETCONN1_P(p) 0 @@ -680,6 +680,7 @@ setup_process_coding_systems (process) struct Lisp_Process *p = XPROCESS (process); int inch = p->infd; int outch = p->outfd; + Lisp_Object coding_system; if (inch < 0 || outch < 0) return; @@ -687,26 +688,24 @@ setup_process_coding_systems (process) if (!proc_decode_coding_system[inch]) proc_decode_coding_system[inch] = (struct coding_system *) xmalloc (sizeof (struct coding_system)); - setup_coding_system (p->decode_coding_system, - proc_decode_coding_system[inch]); + coding_system = p->decode_coding_system; if (! NILP (p->filter)) { if (!p->filter_multibyte) - setup_raw_text_coding_system (proc_decode_coding_system[inch]); + coding_system = raw_text_coding_system (coding_system); } else if (BUFFERP (p->buffer)) { if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters)) - setup_raw_text_coding_system (proc_decode_coding_system[inch]); + coding_system = raw_text_coding_system (coding_system); } + setup_coding_system (coding_system, proc_decode_coding_system[inch]); if (!proc_encode_coding_system[outch]) proc_encode_coding_system[outch] = (struct coding_system *) xmalloc (sizeof (struct coding_system)); setup_coding_system (p->encode_coding_system, proc_encode_coding_system[outch]); - if (proc_encode_coding_system[outch]->eol_type == CODING_EOL_UNDECIDED) - proc_encode_coding_system[outch]->eol_type = system_eol_type; } DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, @@ -5167,13 +5166,13 @@ read_process_output (proc, channel) save the match data in a special nonrecursive fashion. */ running_asynch_code = 1; - text = decode_coding_string (make_unibyte_string (chars, nbytes), - coding, 0); - Vlast_coding_system_used = coding->symbol; + decode_coding_c_string (coding, chars, nbytes, Qt); + text = coding->dst_object; + Vlast_coding_system_used = CODING_ID_NAME (coding->id); /* A new coding system might be found. */ - if (!EQ (p->decode_coding_system, coding->symbol)) + if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) { - p->decode_coding_system = coding->symbol; + p->decode_coding_system = Vlast_coding_system_used; /* Don't call setup_coding_system for proc_decode_coding_system[channel] here. It is done in @@ -5189,25 +5188,21 @@ read_process_output (proc, channel) if (NILP (p->encode_coding_system) && proc_encode_coding_system[p->outfd]) { - p->encode_coding_system = coding->symbol; - setup_coding_system (coding->symbol, + p->encode_coding_system + = coding_inherit_eol_type (Vlast_coding_system_used, Qnil); + setup_coding_system (p->encode_coding_system, proc_encode_coding_system[p->outfd]); - if (proc_encode_coding_system[p->outfd]->eol_type - == CODING_EOL_UNDECIDED) - proc_encode_coding_system[p->outfd]->eol_type - = system_eol_type; } } - carryover = nbytes - coding->consumed; - if (carryover < 0) - abort (); - - if (SCHARS (p->decoding_buf) < carryover) - p->decoding_buf = make_uninit_string (carryover); - bcopy (chars + coding->consumed, SDATA (p->decoding_buf), - carryover); - p->decoding_carryover = carryover; + if (coding->carryover_bytes > 0) + { + if (SCHARS (p->decoding_buf) < coding->carryover_bytes) + p->decoding_buf = make_uninit_string (coding->carryover_bytes); + bcopy (coding->carryover, SDATA (p->decoding_buf), + coding->carryover_bytes); + p->decoding_carryover = coding->carryover_bytes; + } /* Adjust the multibyteness of TEXT to that of the filter. */ if (!p->filter_multibyte != !STRING_MULTIBYTE (text)) text = (STRING_MULTIBYTE (text) @@ -5292,36 +5287,31 @@ read_process_output (proc, channel) if (! (BEGV <= PT && PT <= ZV)) Fwiden (); - text = decode_coding_string (make_unibyte_string (chars, nbytes), - coding, 0); - Vlast_coding_system_used = coding->symbol; + decode_coding_c_string (coding, chars, nbytes, Qt); + text = coding->dst_object; + Vlast_coding_system_used = CODING_ID_NAME (coding->id); /* A new coding system might be found. See the comment in the similar code in the previous `if' block. */ - if (!EQ (p->decode_coding_system, coding->symbol)) + if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) { - p->decode_coding_system = coding->symbol; + p->decode_coding_system = Vlast_coding_system_used; if (NILP (p->encode_coding_system) && proc_encode_coding_system[p->outfd]) { - p->encode_coding_system = coding->symbol; - setup_coding_system (coding->symbol, + p->encode_coding_system + = coding_inherit_eol_type (Vlast_coding_system_used, Qnil); + setup_coding_system (p->encode_coding_system, proc_encode_coding_system[p->outfd]); - if (proc_encode_coding_system[p->outfd]->eol_type - == CODING_EOL_UNDECIDED) - proc_encode_coding_system[p->outfd]->eol_type - = system_eol_type; } } - carryover = nbytes - coding->consumed; - if (carryover < 0) - abort (); - - if (SCHARS (p->decoding_buf) < carryover) - p->decoding_buf = make_uninit_string (carryover); - bcopy (chars + coding->consumed, SDATA (p->decoding_buf), - carryover); - p->decoding_carryover = carryover; - + if (coding->carryover_bytes > 0) + { + if (SCHARS (p->decoding_buf) < coding->carryover_bytes) + p->decoding_buf = make_uninit_string (coding->carryover_bytes); + bcopy (coding->carryover, SDATA (p->decoding_buf), + coding->carryover_bytes); + p->decoding_carryover = coding->carryover_bytes; + } /* Adjust the multibyteness of TEXT to that of the buffer. */ if (NILP (current_buffer->enable_multibyte_characters) != ! STRING_MULTIBYTE (text)) @@ -5443,24 +5433,19 @@ send_process (proc, buf, len, object) error ("Output file descriptor of %s is closed", SDATA (p->name)); coding = proc_encode_coding_system[p->outfd]; - Vlast_coding_system_used = coding->symbol; + Vlast_coding_system_used = CODING_ID_NAME (coding->id); if ((STRINGP (object) && STRING_MULTIBYTE (object)) || (BUFFERP (object) && !NILP (XBUFFER (object)->enable_multibyte_characters)) || EQ (object, Qt)) { - if (!EQ (coding->symbol, p->encode_coding_system)) + if (!EQ (Vlast_coding_system_used, p->encode_coding_system)) /* The coding system for encoding was changed to raw-text because we sent a unibyte text previously. Now we are sending a multibyte text, thus we must encode it by the original coding system specified for the current process. */ setup_coding_system (p->encode_coding_system, coding); - if (coding->eol_type == CODING_EOL_UNDECIDED) - coding->eol_type = system_eol_type; - /* src_multibyte should be set to 1 _after_ a call to - setup_coding_system, since it resets src_multibyte to - zero. */ coding->src_multibyte = 1; } else @@ -5468,60 +5453,56 @@ send_process (proc, buf, len, object) /* For sending a unibyte text, character code conversion should not take place but EOL conversion should. So, setup raw-text or one of the subsidiary if we have not yet done it. */ - if (coding->type != coding_type_raw_text) + if (CODING_REQUIRE_ENCODING (coding)) { if (CODING_REQUIRE_FLUSHING (coding)) { /* But, before changing the coding, we must flush out data. */ coding->mode |= CODING_MODE_LAST_BLOCK; send_process (proc, "", 0, Qt); + coding->mode &= CODING_MODE_LAST_BLOCK; } + setup_coding_system (raw_text_coding_system + (Vlast_coding_system_used), + coding); coding->src_multibyte = 0; - setup_raw_text_coding_system (coding); } } coding->dst_multibyte = 0; if (CODING_REQUIRE_ENCODING (coding)) { - int require = encoding_buffer_size (coding, len); - int from_byte = -1, from = -1, to = -1; - + coding->dst_object = Qt; if (BUFFERP (object)) { - from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf); - from = buf_bytepos_to_charpos (XBUFFER (object), from_byte); - to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len); + int from_byte, from, to; + int save_pt, save_pt_byte; + struct buffer *cur = current_buffer; + + set_buffer_internal (XBUFFER (object)); + save_pt = PT, save_pt_byte = PT_BYTE; + + from_byte = PTR_BYTE_POS (buf); + from = BYTE_TO_CHAR (from_byte); + to = BYTE_TO_CHAR (from_byte + len); + TEMP_SET_PT_BOTH (from, from_byte); + encode_coding_object (coding, object, from, from_byte, + to, from_byte + len, Qt); + TEMP_SET_PT_BOTH (save_pt, save_pt_byte); + set_buffer_internal (cur); } else if (STRINGP (object)) { - from_byte = buf - SDATA (object); - from = string_byte_to_char (object, from_byte); - to = string_byte_to_char (object, from_byte + len); + encode_coding_string (coding, object, 1); } - - if (coding->composing != COMPOSITION_DISABLED) + else { - if (from_byte >= 0) - coding_save_composition (coding, from, to, object); - else - coding->composing = COMPOSITION_DISABLED; + coding->dst_object = make_unibyte_string (buf, len); + coding->produced = len; } - if (SBYTES (p->encoding_buf) < require) - p->encoding_buf = make_uninit_string (require); - - if (from_byte >= 0) - buf = (BUFFERP (object) - ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte) - : SDATA (object) + from_byte); - - object = p->encoding_buf; - encode_coding (coding, (char *) buf, SDATA (object), - len, SBYTES (object)); - coding_free_composition_data (coding); len = coding->produced; - buf = SDATA (object); + buf = SDATA (coding->dst_object); } #ifdef VMS @@ -5715,91 +5696,6 @@ send_process (proc, buf, len, object) UNGCPRO; } -static Lisp_Object -send_process_object_unwind (buf) - Lisp_Object buf; -{ - Lisp_Object tembuf; - - if (XBUFFER (buf) == current_buffer) - return Qnil; - tembuf = Fcurrent_buffer (); - Fset_buffer (buf); - Fkill_buffer (tembuf); - return Qnil; -} - -/* Send current contents of region between START and END to PROC. - If START is a string, send it instead. - This function can evaluate Lisp code and can garbage collect. */ - -static void -send_process_object (proc, start, end) - Lisp_Object proc, start, end; -{ - int count = SPECPDL_INDEX (); - Lisp_Object object = STRINGP (start) ? start : Fcurrent_buffer (); - struct buffer *given_buffer = current_buffer; - unsigned char *buf; - int len; - - record_unwind_protect (send_process_object_unwind, Fcurrent_buffer ()); - - if (STRINGP (object) ? STRING_MULTIBYTE (object) - : ! NILP (XBUFFER (object)->enable_multibyte_characters)) - { - struct Lisp_Process *p = XPROCESS (proc); - struct coding_system *coding; - - if (p->raw_status_new) - update_status (p); - if (! EQ (p->status, Qrun)) - error ("Process %s not running", SDATA (p->name)); - if (p->outfd < 0) - error ("Output file descriptor of %s is closed", SDATA (p->name)); - - coding = proc_encode_coding_system[p->outfd]; - if (! EQ (coding->symbol, p->encode_coding_system)) - /* The coding system for encoding was changed to raw-text - because we sent a unibyte text previously. Now we are - sending a multibyte text, thus we must encode it by the - original coding system specified for the current process. */ - setup_coding_system (p->encode_coding_system, coding); - if (! NILP (coding->pre_write_conversion)) - { - struct gcpro gcpro1, gcpro2; - - GCPRO2 (proc, object); - call2 (coding->pre_write_conversion, start, end); - UNGCPRO; - if (given_buffer != current_buffer) - { - start = make_number (BEGV), end = make_number (ZV); - object = Fcurrent_buffer (); - } - } - } - - if (BUFFERP (object)) - { - EMACS_INT start_byte; - - if (XINT (start) < GPT && XINT (end) > GPT) - move_gap (XINT (end)); - start_byte = CHAR_TO_BYTE (XINT (start)); - buf = BYTE_POS_ADDR (start_byte); - len = CHAR_TO_BYTE (XINT (end)) - start_byte; - } - else - { - buf = SDATA (object); - len = SBYTES (object); - } - send_process (proc, buf, len, object); - - unbind_to (count, Qnil); -} - DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, 3, 3, 0, doc: /* Send current contents of region as input to PROCESS. @@ -5813,10 +5709,19 @@ Output from processes can arrive in between bunches. */) Lisp_Object process, start, end; { Lisp_Object proc; + int start1, end1; proc = get_process (process); validate_region (&start, &end); - send_process_object (proc, start, end); + + if (XINT (start) < GPT && XINT (end) > GPT) + move_gap (XINT (start)); + + start1 = CHAR_TO_BYTE (XINT (start)); + end1 = CHAR_TO_BYTE (XINT (end)); + send_process (proc, BYTE_POS_ADDR (start1), end1 - start1, + Fcurrent_buffer ()); + return Qnil; } @@ -5834,7 +5739,8 @@ Output from processes can arrive in between bunches. */) Lisp_Object proc; CHECK_STRING (string); proc = get_process (process); - send_process_object (proc, string, Qnil); + send_process (proc, SDATA (string), + SBYTES (string), string); return Qnil; } @@ -6483,10 +6389,10 @@ kill_buffer_processes (buffer) { Lisp_Object tail, proc; - for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) { proc = XCDR (XCAR (tail)); - if (GC_PROCESSP (proc) + if (PROCESSP (proc) && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) { if (NETCONN_P (proc)) @@ -6581,11 +6487,11 @@ sigchld_handler (signo) /* Find the process that signaled us, and record its status. */ /* The process can have been deleted by Fdelete_process. */ - for (tail = deleted_pid_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object xpid = XCAR (tail); - if ((GC_INTEGERP (xpid) && pid == (pid_t) XINT (xpid)) - || (GC_FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid))) + if ((INTEGERP (xpid) && pid == (pid_t) XINT (xpid)) + || (FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid))) { XSETCAR (tail, Qnil); goto sigchld_end_of_loop; @@ -6594,11 +6500,11 @@ sigchld_handler (signo) /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */ p = 0; - for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) { proc = XCDR (XCAR (tail)); p = XPROCESS (proc); - if (GC_EQ (p->childp, Qt) && p->pid == pid) + if (EQ (p->childp, Qt) && p->pid == pid) break; p = 0; } @@ -6606,7 +6512,7 @@ sigchld_handler (signo) /* Look for an asynchronous process whose pid hasn't been filled in yet. */ if (p == 0) - for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) { proc = XCDR (XCAR (tail)); p = XPROCESS (proc); @@ -6929,7 +6835,7 @@ encode subprocess input. */) error ("Output file descriptor of %s closed", SDATA (p->name)); Fcheck_coding_system (decoding); Fcheck_coding_system (encoding); - + encoding = coding_inherit_eol_type (encoding, Qnil); p->decode_coding_system = decoding; p->encode_coding_system = encoding; setup_process_coding_systems (process); @@ -7348,7 +7254,7 @@ The variable takes effect when `start-process' is called. */); #include "lisp.h" #include "systime.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "termopts.h" #include "sysselect.h" diff --git a/src/regex.c b/src/regex.c index 125a3388f19..a0d6b945cf1 100644 --- a/src/regex.c +++ b/src/regex.c @@ -124,7 +124,7 @@ # define SYNTAX_ENTRY_VIA_PROPERTY # include "syntax.h" -# include "charset.h" +# include "character.h" # include "category.h" # ifdef malloc @@ -145,28 +145,51 @@ # define POS_AS_IN_BUFFER(p) ((p) + (NILP (re_match_object) || BUFFERP (re_match_object))) # define RE_MULTIBYTE_P(bufp) ((bufp)->multibyte) -# define RE_STRING_CHAR(p, s) \ +# define RE_TARGET_MULTIBYTE_P(bufp) ((bufp)->target_multibyte) +# define RE_STRING_CHAR(p, s, multibyte) \ (multibyte ? (STRING_CHAR (p, s)) : (*(p))) -# define RE_STRING_CHAR_AND_LENGTH(p, s, len) \ +# define RE_STRING_CHAR_AND_LENGTH(p, s, len, multibyte) \ (multibyte ? (STRING_CHAR_AND_LENGTH (p, s, len)) : ((len) = 1, *(p))) -/* Set C a (possibly multibyte) character before P. P points into a - string which is the virtual concatenation of STR1 (which ends at - END1) or STR2 (which ends at END2). */ -# define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \ - do { \ - if (multibyte) \ - { \ - re_char *dtemp = (p) == (str2) ? (end1) : (p); \ - re_char *dlimit = ((p) > (str2) && (p) <= (end2)) ? (str2) : (str1); \ - re_char *d0 = dtemp; \ - PREV_CHAR_BOUNDARY (d0, dlimit); \ - c = STRING_CHAR (d0, dtemp - d0); \ - } \ - else \ - (c = ((p) == (str2) ? (end1) : (p))[-1]); \ +# define RE_CHAR_TO_MULTIBYTE(c) unibyte_to_multibyte_table[(c)] + +# define RE_CHAR_TO_UNIBYTE(c) \ + (ASCII_CHAR_P (c) ? (c) \ + : CHAR_BYTE8_P (c) ? CHAR_TO_BYTE8 (c) \ + : multibyte_char_to_unibyte_safe (c)) + +/* Set C a (possibly converted to multibyte) character before P. P + points into a string which is the virtual concatenation of STR1 + (which ends at END1) or STR2 (which ends at END2). */ +# define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \ + do { \ + if (target_multibyte) \ + { \ + re_char *dtemp = (p) == (str2) ? (end1) : (p); \ + re_char *dlimit = ((p) > (str2) && (p) <= (end2)) ? (str2) : (str1); \ + while (dtemp-- > dlimit && !CHAR_HEAD_P (*dtemp)); \ + c = STRING_CHAR (dtemp, (p) - dtemp); \ + } \ + else \ + { \ + (c = ((p) == (str2) ? (end1) : (p))[-1]); \ + (c) = RE_CHAR_TO_MULTIBYTE (c); \ + } \ } while (0) +/* Set C a (possibly converted to multibyte) character at P, and set + LEN to the byte length of that character. */ +# define GET_CHAR_AFTER(c, p, len) \ + do { \ + if (target_multibyte) \ + (c) = STRING_CHAR_AND_LENGTH (p, 0, len); \ + else \ + { \ + (c) = *p; \ + len = 1; \ + (c) = RE_CHAR_TO_MULTIBYTE (c); \ + } \ + } while (0) #else /* not emacs */ @@ -278,6 +301,7 @@ enum syntaxcode { Swhitespace = 0, Sword = 1, Ssymbol = 2 }; # define CHARSET_LEADING_CODE_BASE(c) 0 # define MAX_MULTIBYTE_LENGTH 1 # define RE_MULTIBYTE_P(x) 0 +# define RE_TARGET_MULTIBYTE_P(x) 0 # define WORD_BOUNDARY_P(c1, c2) (0) # define CHAR_HEAD_P(p) (1) # define SINGLE_BYTE_CHAR_P(c) (1) @@ -285,13 +309,21 @@ enum syntaxcode { Swhitespace = 0, Sword = 1, Ssymbol = 2 }; # define MULTIBYTE_FORM_LENGTH(p, s) (1) # define PREV_CHAR_BOUNDARY(p, limit) ((p)--) # define STRING_CHAR(p, s) (*(p)) -# define RE_STRING_CHAR STRING_CHAR +# define RE_STRING_CHAR(p, s, multibyte) STRING_CHAR ((p), (s)) # define CHAR_STRING(c, s) (*(s) = (c), 1) # define STRING_CHAR_AND_LENGTH(p, s, actual_len) ((actual_len) = 1, *(p)) -# define RE_STRING_CHAR_AND_LENGTH STRING_CHAR_AND_LENGTH +# define RE_STRING_CHAR_AND_LENGTH(p, s, len, multibyte) STRING_CHAR_AND_LENGTH ((p), (s), (len)) +# define RE_CHAR_TO_MULTIBYTE(c) (c) +# define RE_CHAR_TO_UNIBYTE(c) (c) # define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \ (c = ((p) == (str2) ? *((end1) - 1) : *((p) - 1))) +# define GET_CHAR_AFTER(c, p, len) \ + (c = *p, len = 1) # define MAKE_CHAR(charset, c1, c2) (c1) +# define BYTE8_TO_CHAR(c) (c) +# define CHAR_BYTE8_P(c) (0) +# define CHAR_LEADING_CODE(c) (c) + #endif /* not emacs */ #ifndef RE_TRANSLATE @@ -497,7 +529,7 @@ init_syntax_once () # ifdef __GNUC__ # define alloca __builtin_alloca # else /* not __GNUC__ */ -# if HAVE_ALLOCA_H +# ifdef HAVE_ALLOCA_H # include <alloca.h> # endif /* HAVE_ALLOCA_H */ # endif /* not __GNUC__ */ @@ -1731,7 +1763,7 @@ static int analyse_first _RE_ARGS ((re_char *p, re_char *pend, do { \ int len; \ if (p == pend) return REG_EEND; \ - c = RE_STRING_CHAR_AND_LENGTH (p, pend - p, len); \ + c = RE_STRING_CHAR_AND_LENGTH (p, pend - p, len, multibyte); \ p += len; \ } while (0) @@ -1942,10 +1974,10 @@ struct range_table_work_area #define EXTEND_RANGE_TABLE(work_area, n) \ do { \ - if (((work_area)->used + (n)) * sizeof (int) > (work_area)->allocated) \ + if (((work_area).used + (n)) * sizeof (int) > (work_area).allocated) \ { \ - extend_range_table_work_area (work_area); \ - if ((work_area)->table == 0) \ + extend_range_table_work_area (&work_area); \ + if ((work_area).table == 0) \ return (REG_ESPACE); \ } \ } while (0) @@ -1962,15 +1994,12 @@ struct range_table_work_area #define BIT_UPPER 0x10 #define BIT_MULTIBYTE 0x20 -/* Set a range START..END to WORK_AREA. - The range is passed through TRANSLATE, so START and END - should be untranslated. */ -#define SET_RANGE_TABLE_WORK_AREA(work_area, start, end) \ +/* Set a range (RANGE_START, RANGE_END) to WORK_AREA. */ +#define SET_RANGE_TABLE_WORK_AREA(work_area, range_start, range_end) \ do { \ - int tem; \ - tem = set_image_of_range (&work_area, start, end, translate); \ - if (tem > 0) \ - FREE_STACK_RETURN (tem); \ + EXTEND_RANGE_TABLE ((work_area), 2); \ + (work_area).table[(work_area).used++] = (range_start); \ + (work_area).table[(work_area).used++] = (range_end); \ } while (0) /* Free allocated memory for WORK_AREA. */ @@ -1990,6 +2019,113 @@ struct range_table_work_area #define SET_LIST_BIT(c) (b[((c)) / BYTEWIDTH] |= 1 << ((c) % BYTEWIDTH)) +#ifdef emacs + +/* Store characters in the range FROM to TO in the bitmap at B (for + ASCII and unibyte characters) and WORK_AREA (for multibyte + characters) while translating them and paying attention to the + continuity of translated characters. + + Implementation note: It is better to implement these fairly big + macros by a function, but it's not that easy because macros called + in this macro assume various local variables already declared. */ + +/* Both FROM and TO are ASCII characters. */ + +#define SETUP_ASCII_RANGE(work_area, FROM, TO) \ + do { \ + int C0, C1; \ + \ + for (C0 = (FROM); C0 <= (TO); C0++) \ + { \ + C1 = TRANSLATE (C0); \ + if (! ASCII_CHAR_P (C1)) \ + { \ + SET_RANGE_TABLE_WORK_AREA ((work_area), C1, C1); \ + if ((C1 = RE_CHAR_TO_UNIBYTE (C1)) < 0) \ + C1 = C0; \ + } \ + SET_LIST_BIT (C1); \ + } \ + } while (0) + + +/* Both FROM and TO are unibyte characters (0x80..0xFF). */ + +#define SETUP_UNIBYTE_RANGE(work_area, FROM, TO) \ + do { \ + int C0, C1, C2, I; \ + int USED = RANGE_TABLE_WORK_USED (work_area); \ + \ + for (C0 = (FROM); C0 <= (TO); C0++) \ + { \ + C1 = RE_CHAR_TO_MULTIBYTE (C0); \ + if (CHAR_BYTE8_P (C1)) \ + SET_LIST_BIT (C0); \ + else \ + { \ + C2 = TRANSLATE (C1); \ + if (C2 == C1 \ + || (C1 = RE_CHAR_TO_UNIBYTE (C2)) < 0) \ + C1 = C0; \ + SET_LIST_BIT (C1); \ + for (I = RANGE_TABLE_WORK_USED (work_area) - 2; I >= USED; I -= 2) \ + { \ + int from = RANGE_TABLE_WORK_ELT (work_area, I); \ + int to = RANGE_TABLE_WORK_ELT (work_area, I + 1); \ + \ + if (C2 >= from - 1 && C2 <= to + 1) \ + { \ + if (C2 == from - 1) \ + RANGE_TABLE_WORK_ELT (work_area, I)--; \ + else if (C2 == to + 1) \ + RANGE_TABLE_WORK_ELT (work_area, I + 1)++; \ + break; \ + } \ + } \ + if (I < USED) \ + SET_RANGE_TABLE_WORK_AREA ((work_area), C2, C2); \ + } \ + } \ + } while (0) + + +/* Both FROM and TO are mulitbyte characters. */ + +#define SETUP_MULTIBYTE_RANGE(work_area, FROM, TO) \ + do { \ + int C0, C1, C2, I, USED = RANGE_TABLE_WORK_USED (work_area); \ + \ + SET_RANGE_TABLE_WORK_AREA ((work_area), (FROM), (TO)); \ + for (C0 = (FROM); C0 <= (TO); C0++) \ + { \ + C1 = TRANSLATE (C0); \ + if ((C2 = RE_CHAR_TO_UNIBYTE (C1)) >= 0 \ + || (C1 != C0 && (C2 = RE_CHAR_TO_UNIBYTE (C0)) >= 0)) \ + SET_LIST_BIT (C2); \ + if (C1 >= (FROM) && C1 <= (TO)) \ + continue; \ + for (I = RANGE_TABLE_WORK_USED (work_area) - 2; I >= USED; I -= 2) \ + { \ + int from = RANGE_TABLE_WORK_ELT (work_area, I); \ + int to = RANGE_TABLE_WORK_ELT (work_area, I + 1); \ + \ + if (C1 >= from - 1 && C1 <= to + 1) \ + { \ + if (C1 == from - 1) \ + RANGE_TABLE_WORK_ELT (work_area, I)--; \ + else if (C1 == to + 1) \ + RANGE_TABLE_WORK_ELT (work_area, I + 1)++; \ + break; \ + } \ + } \ + if (I < USED) \ + SET_RANGE_TABLE_WORK_AREA ((work_area), C1, C1); \ + } \ + } while (0) + +#endif /* emacs */ + /* Get the next unsigned number in the uncompiled pattern. */ #define GET_UNSIGNED_NUMBER(num) \ do { \ @@ -2113,6 +2249,7 @@ extend_range_table_work_area (work_area) = (int *) malloc (work_area->allocated); } +#if 0 #ifdef emacs /* Carefully find the ranges of codes that are equivalent @@ -2345,6 +2482,7 @@ set_image_of_range (work_area, start, end, translate) return -1; } +#endif /* 0 */ #ifndef MATCH_MAY_ALLOCATE @@ -2483,6 +2621,9 @@ regex_compile (pattern, size, syntax, bufp) /* If the object matched can contain multibyte characters. */ const boolean multibyte = RE_MULTIBYTE_P (bufp); + /* If a target of matching can contain multibyte characters. */ + const boolean target_multibyte = RE_TARGET_MULTIBYTE_P (bufp); + /* Nonzero if we have pushed down into a subpattern. */ int in_subpattern = 0; @@ -2835,6 +2976,7 @@ regex_compile (pattern, size, syntax, bufp) { boolean escaped_char = false; const unsigned char *p2 = p; + re_wchar_t ch, c2; if (p == pend) FREE_STACK_RETURN (REG_EBRACK); @@ -2861,10 +3003,6 @@ regex_compile (pattern, size, syntax, bufp) break; } - /* What should we do for the character which is - greater than 0x7F, but not BASE_LEADING_CODE_P? - XXX */ - /* See if we're at the beginning of a possible character class. */ @@ -2901,8 +3039,8 @@ regex_compile (pattern, size, syntax, bufp) them). */ if (c == ':' && *p == ']') { - re_wchar_t ch; re_wctype_t cc; + int limit; cc = re_wctype (str); @@ -2915,6 +3053,15 @@ regex_compile (pattern, size, syntax, bufp) if (p == pend) FREE_STACK_RETURN (REG_EBRACK); +#ifndef emacs + for (ch = 0; ch < (1 << BYTEWIDTH); ++ch) + if (re_iswctype (btowc (ch), cc)) + { + c = TRANSLATE (ch); + if (c < (1 << BYTEWIDTH)) + SET_LIST_BIT (c); + } +#else /* emacs */ /* Most character classes in a multibyte match just set a flag. Exceptions are is_blank, is_digit, is_cntrl, and is_xdigit, since @@ -2922,18 +3069,25 @@ regex_compile (pattern, size, syntax, bufp) don't need to handle them for multibyte. They are distinguished by a negative wctype. */ - if (multibyte) - SET_RANGE_TABLE_WORK_AREA_BIT (range_table_work, - re_wctype_to_bit (cc)); - - for (ch = 0; ch < 1 << BYTEWIDTH; ++ch) + for (ch = 0; ch < 256; ++ch) { - int translated = TRANSLATE (ch); - if (translated < (1 << BYTEWIDTH) - && re_iswctype (btowc (ch), cc)) - SET_LIST_BIT (translated); + c = RE_CHAR_TO_MULTIBYTE (ch); + if (! CHAR_BYTE8_P (c) + && re_iswctype (c, cc)) + { + SET_LIST_BIT (ch); + c1 = TRANSLATE (c); + if (c1 == c) + continue; + if (ASCII_CHAR_P (c1)) + SET_LIST_BIT (c1); + else if ((c1 = RE_CHAR_TO_UNIBYTE (c1)) >= 0) + SET_LIST_BIT (c1); + } } - + SET_RANGE_TABLE_WORK_AREA_BIT + (range_table_work, re_wctype_to_bit (cc)); +#endif /* emacs */ /* In most cases the matching rule for char classes only uses the syntax table for multibyte chars, so that the content of the syntax-table it is not @@ -2966,64 +3120,63 @@ regex_compile (pattern, size, syntax, bufp) /* Fetch the character which ends the range. */ PATFETCH (c1); - - if (SINGLE_BYTE_CHAR_P (c)) - { - if (! SINGLE_BYTE_CHAR_P (c1)) - { - /* Handle a range starting with a - character of less than 256, and ending - with a character of not less than 256. - Split that into two ranges, the low one - ending at 0377, and the high one - starting at the smallest character in - the charset of C1 and ending at C1. */ - int charset = CHAR_CHARSET (c1); - re_wchar_t c2 = MAKE_CHAR (charset, 0, 0); - - SET_RANGE_TABLE_WORK_AREA (range_table_work, - c2, c1); - c1 = 0377; - } - } - else if (!SAME_CHARSET_P (c, c1)) - FREE_STACK_RETURN (REG_ERANGEX); +#ifdef emacs + if (CHAR_BYTE8_P (c1) + && ! ASCII_CHAR_P (c) && ! CHAR_BYTE8_P (c)) + /* Treat the range from a multibyte character to + raw-byte character as empty. */ + c = c1 + 1; +#endif /* emacs */ } else /* Range from C to C. */ c1 = c; - /* Set the range ... */ - if (SINGLE_BYTE_CHAR_P (c)) - /* ... into bitmap. */ + if (c > c1) { - re_wchar_t this_char; - re_wchar_t range_start = c, range_end = c1; - - /* If the start is after the end, the range is empty. */ - if (range_start > range_end) + if (syntax & RE_NO_EMPTY_RANGES) + FREE_STACK_RETURN (REG_ERANGEX); + /* Else, repeat the loop. */ + } + else + { +#ifndef emacs + /* Set the range into bitmap */ + for (; c <= c1; c++) { - if (syntax & RE_NO_EMPTY_RANGES) - FREE_STACK_RETURN (REG_ERANGE); - /* Else, repeat the loop. */ + ch = TRANSLATE (c); + if (ch < (1 << BYTEWIDTH)) + SET_LIST_BIT (ch); } - else +#else /* emacs */ + if (c < 128) + { + ch = MIN (127, c1); + SETUP_ASCII_RANGE (range_table_work, c, ch); + c = ch + 1; + if (CHAR_BYTE8_P (c1)) + c = BYTE8_TO_CHAR (128); + } + if (c <= c1) { - for (this_char = range_start; this_char <= range_end; - this_char++) + if (CHAR_BYTE8_P (c)) + { + c = CHAR_TO_BYTE8 (c); + c1 = CHAR_TO_BYTE8 (c1); + for (; c <= c1; c++) + SET_LIST_BIT (c); + } + else if (multibyte) + { + SETUP_MULTIBYTE_RANGE (range_table_work, c, c1); + } + else { - int translated = TRANSLATE (this_char); - if (translated < (1 << BYTEWIDTH)) - SET_LIST_BIT (translated); - else - SET_RANGE_TABLE_WORK_AREA - (range_table_work, translated, translated); + SETUP_UNIBYTE_RANGE (range_table_work, c, c1); } } +#endif /* emacs */ } - else - /* ... into range table. */ - SET_RANGE_TABLE_WORK_AREA (range_table_work, c, c1); } /* Discard any (non)matching list bytes that are all 0 at the @@ -3634,12 +3787,25 @@ regex_compile (pattern, size, syntax, bufp) { int len; - c = TRANSLATE (c); if (multibyte) - len = CHAR_STRING (c, b); + { + c = TRANSLATE (c); + len = CHAR_STRING (c, b); + b += len; + } else - *b = c, len = 1; - b += len; + { + c1 = RE_CHAR_TO_MULTIBYTE (c); + if (! CHAR_BYTE8_P (c1)) + { + re_wchar_t c2 = TRANSLATE (c1); + + if (c1 != c2 && (c1 = RE_CHAR_TO_UNIBYTE (c2)) >= 0) + c = c1; + } + *b++ = c; + len = 1; + } (*pending_exact) += len; } @@ -3909,14 +4075,21 @@ analyse_first (p, pend, fastmap, multibyte) case exactn: if (fastmap) { - int c = RE_STRING_CHAR (p + 1, pend - p); - /* When fast-scanning, the fastmap can be indexed either with - a char (smaller than 256) or with the first byte of - a char's byte sequence. So we have to conservatively add - both to the table. */ - if (SINGLE_BYTE_CHAR_P (c)) - fastmap[c] = 1; + /* If multibyte is nonzero, the first byte of each + character is an ASCII or a leading code. Otherwise, + each byte is a character. Thus, this works in both + cases. */ fastmap[p[1]] = 1; + if (! multibyte) + { + /* For the case of matching this unibyte regex + against multibyte, we must set a leading code of + the corresponding multibyte character. */ + int c = RE_CHAR_TO_MULTIBYTE (p[1]); + + if (! CHAR_BYTE8_P (c)) + fastmap[CHAR_LEADING_CODE (c)] = 1; + } } break; @@ -3929,18 +4102,14 @@ analyse_first (p, pend, fastmap, multibyte) case charset_not: - /* Chars beyond end of bitmap are possible matches. - All the single-byte codes can occur in multibyte buffers. - So any that are not listed in the charset - are possible matches, even in multibyte buffers. */ if (!fastmap) break; - /* We don't need to mark LEADING_CODE_8_BIT_CONTROL specially - because it will automatically be set when needed by virtue of - being larger than the highest char of its charset (0xbf) but - smaller than (1<<BYTEWIDTH). */ - for (j = CHARSET_BITMAP_SIZE (&p[-1]) * BYTEWIDTH; - j < (1 << BYTEWIDTH); j++) - fastmap[j] = 1; + { + /* Chars beyond end of bitmap are possible matches. */ + for (j = CHARSET_BITMAP_SIZE (&p[-1]) * BYTEWIDTH; + j < (1 << BYTEWIDTH); j++) + fastmap[j] = 1; + } + /* Fallthrough */ case charset: if (!fastmap) break; @@ -3948,28 +4117,24 @@ analyse_first (p, pend, fastmap, multibyte) for (j = CHARSET_BITMAP_SIZE (&p[-1]) * BYTEWIDTH - 1, p++; j >= 0; j--) if (!!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))) ^ not) - { - fastmap[j] = 1; -#ifdef emacs - if (j >= 0x80 && j < 0xa0) - fastmap[LEADING_CODE_8_BIT_CONTROL] = 1; -#endif - } + fastmap[j] = 1; - if ((not && multibyte) - /* Any character set can possibly contain a character +#ifdef emacs + if (/* Any leading code can possibly start a character which doesn't match the specified set of characters. */ - || (CHARSET_RANGE_TABLE_EXISTS_P (&p[-2]) - && CHARSET_RANGE_TABLE_BITS (&p[-2]) != 0)) - /* If we can match a character class, we can match - any character set. */ + not + || + /* If we can match a character class, we can match any + multibyte characters. */ + (CHARSET_RANGE_TABLE_EXISTS_P (&p[-2]) + && CHARSET_RANGE_TABLE_BITS (&p[-2]) != 0)) + { - set_fastmap_for_multibyte_characters: if (match_any_multibyte_characters == false) { - for (j = 0x80; j < 0xA0; j++) /* XXX */ - if (BASE_LEADING_CODE_P (j)) - fastmap[j] = 1; + for (j = MIN_MULTIBYTE_LEADING_CODE; + j <= MAX_MULTIBYTE_LEADING_CODE; j++) + fastmap[j] = 1; match_any_multibyte_characters = true; } } @@ -3977,9 +4142,10 @@ analyse_first (p, pend, fastmap, multibyte) else if (!not && CHARSET_RANGE_TABLE_EXISTS_P (&p[-2]) && match_any_multibyte_characters == false) { - /* Set fastmap[I] 1 where I is a base leading code of each - multibyte character in the range table. */ + /* Set fastmap[I] to 1 where I is a leading code of each + multibyte characer in the range table. */ int c, count; + unsigned char lc1, lc2; /* Make P points the range table. `+ 2' is to skip flag bits for a character class. */ @@ -3987,14 +4153,19 @@ analyse_first (p, pend, fastmap, multibyte) /* Extract the number of ranges in range table into COUNT. */ EXTRACT_NUMBER_AND_INCR (count, p); - for (; count > 0; count--, p += 2 * 3) /* XXX */ + for (; count > 0; count--, p += 3) { - /* Extract the start of each range. */ + /* Extract the start and end of each range. */ + EXTRACT_CHARACTER (c, p); + lc1 = CHAR_LEADING_CODE (c); + p += 3; EXTRACT_CHARACTER (c, p); - j = CHAR_CHARSET (c); - fastmap[CHARSET_LEADING_CODE_BASE (j)] = 1; + lc2 = CHAR_LEADING_CODE (c); + for (j = lc1; j <= lc2; j++) + fastmap[j] = 1; } } +#endif break; case syntaxspec: @@ -4017,14 +4188,19 @@ analyse_first (p, pend, fastmap, multibyte) if (!fastmap) break; not = (re_opcode_t)p[-1] == notcategoryspec; k = *p++; - for (j = 0; j < (1 << BYTEWIDTH); j++) + for (j = (1 << BYTEWIDTH); j >= 0; j--) if ((CHAR_HAS_CATEGORY (j, k)) ^ not) fastmap[j] = 1; - if (multibyte) - /* Any character set can possibly contain a character - whose category is K (or not). */ - goto set_fastmap_for_multibyte_characters; + /* Any leading code can possibly start a character which + has or doesn't has the specified category. */ + if (match_any_multibyte_characters == false) + { + for (j = MIN_MULTIBYTE_LEADING_CODE; + j <= MAX_MULTIBYTE_LEADING_CODE; j++) + fastmap[j] = 1; + match_any_multibyte_characters = true; + } break; /* All cases after this match the empty string. These end with @@ -4274,9 +4450,8 @@ re_search_2 (bufp, str1, size1, str2, size2, startpos, range, regs, stop) int total_size = size1 + size2; int endpos = startpos + range; boolean anchored_start; - - /* Nonzero if we have to concern multibyte character. */ - const boolean multibyte = RE_MULTIBYTE_P (bufp); + /* Nonzero if we are searching multibyte string. */ + const boolean multibyte = RE_TARGET_MULTIBYTE_P (bufp); /* Check for out-of-range STARTPOS. */ if (startpos < 0 || startpos > total_size) @@ -4372,59 +4547,51 @@ re_search_2 (bufp, str1, size1, str2, size2, startpos, range, regs, stop) buf_ch = STRING_CHAR_AND_LENGTH (d, range - lim, buf_charlen); - buf_ch = RE_TRANSLATE (translate, buf_ch); - if (buf_ch >= 0400 - || fastmap[buf_ch]) + if (fastmap[CHAR_LEADING_CODE (buf_ch)]) break; range -= buf_charlen; d += buf_charlen; } else - { - /* Convert *d to integer to shut up GCC's - whining about comparison that is always - true. */ - int di = *d; - - while (range > lim - && !fastmap[RE_TRANSLATE (translate, di)]) - { - di = *(++d); - range--; - } - } - } - else - do - { - re_char *d_start = d; - while (range > lim && !fastmap[*d]) + while (range > lim) { + register re_wchar_t ch, translated; + + buf_ch = *d; + ch = RE_CHAR_TO_MULTIBYTE (buf_ch); + translated = RE_TRANSLATE (translate, ch); + if (translated != ch + && (ch = RE_CHAR_TO_UNIBYTE (translated)) >= 0) + buf_ch = ch; + if (fastmap[buf_ch]) + break; d++; range--; } -#ifdef emacs - if (multibyte && range > lim) + } + else + { + if (multibyte) + while (range > lim) { - /* Check that we are at the beginning of a char. */ - int at_boundary; - AT_CHAR_BOUNDARY_P (at_boundary, d, d_start); - if (at_boundary) + int buf_charlen; + + buf_ch = STRING_CHAR_AND_LENGTH (d, range - lim, + buf_charlen); + if (fastmap[CHAR_LEADING_CODE (buf_ch)]) break; - else - { /* We have matched an internal byte of a char - rather than the leading byte, so it's a false - positive: we should keep scanning. */ - d++; range--; - } + range -= buf_charlen; + d += buf_charlen; } - else -#endif - break; - } while (1); - + else + while (range > lim && !fastmap[*d]) + { + d++; + range--; + } + } startpos += irange - range; } else /* Searching backwards. */ @@ -4432,12 +4599,26 @@ re_search_2 (bufp, str1, size1, str2, size2, startpos, range, regs, stop) int room = (startpos >= size1 ? size2 + size1 - startpos : size1 - startpos); - buf_ch = RE_STRING_CHAR (d, room); - buf_ch = TRANSLATE (buf_ch); - - if (! (buf_ch >= 0400 - || fastmap[buf_ch])) - goto advance; + if (multibyte) + { + buf_ch = STRING_CHAR (d, room); + buf_ch = TRANSLATE (buf_ch); + if (! fastmap[CHAR_LEADING_CODE (buf_ch)]) + goto advance; + } + else + { + register re_wchar_t ch, translated; + + buf_ch = *d; + ch = RE_CHAR_TO_MULTIBYTE (buf_ch); + translated = TRANSLATE (ch); + if (translated != ch + && (ch = RE_CHAR_TO_UNIBYTE (translated)) >= 0) + buf_ch = ch; + if (! fastmap[TRANSLATE (buf_ch)]) + goto advance; + } } } @@ -4711,11 +4892,11 @@ mutually_exclusive_p (bufp, p1, p2) { register re_wchar_t c = (re_opcode_t) *p2 == endline ? '\n' - : RE_STRING_CHAR (p2 + 2, pend - p2 - 2); + : RE_STRING_CHAR (p2 + 2, pend - p2 - 2, multibyte); if ((re_opcode_t) *p1 == exactn) { - if (c != RE_STRING_CHAR (p1 + 2, pend - p1 - 2)) + if (c != RE_STRING_CHAR (p1 + 2, pend - p1 - 2, multibyte)) { DEBUG_PRINT3 (" '%c' != '%c' => fast loop.\n", c, p1[2]); return 1; @@ -4729,7 +4910,7 @@ mutually_exclusive_p (bufp, p1, p2) /* Test if C is listed in charset (or charset_not) at `p1'. */ - if (SINGLE_BYTE_CHAR_P (c)) + if (! multibyte || IS_REAL_ASCII (c)) { if (c < CHARSET_BITMAP_SIZE (p1) * BYTEWIDTH && p1[2 + c / BYTEWIDTH] & (1 << (c % BYTEWIDTH))) @@ -4772,9 +4953,10 @@ mutually_exclusive_p (bufp, p1, p2) size of bitmap table of P1 is extracted by using macro `CHARSET_BITMAP_SIZE'. - Since we know that all the character listed in - P2 is ASCII, it is enough to test only bitmap - table of P1. */ + In a multibyte case, we know that all the character + listed in P2 is ASCII. In a unibyte case, P1 has only a + bitmap table. So, in both cases, it is enough to test + only the bitmap table of P1. */ if ((re_opcode_t) *p1 == charset) { @@ -4932,6 +5114,7 @@ re_match_2 (bufp, string1, size1, string2, size2, pos, regs, stop) } WEAK_ALIAS (__re_match_2, re_match_2) + /* This is a separate function so that we can force an alloca cleanup afterwards. */ static int @@ -4968,12 +5151,15 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) re_char *p = bufp->buffer; re_char *pend = p + bufp->used; - /* We use this to map every character in the string. */ + /* We use this to map every character in the string. */ RE_TRANSLATE_TYPE translate = bufp->translate; - /* Nonzero if we have to concern multibyte character. */ + /* Nonzero if BUFP is setup from a multibyte regex. */ const boolean multibyte = RE_MULTIBYTE_P (bufp); + /* Nonzero if STRING1/STRING2 are multibyte. */ + const boolean target_multibyte = RE_TARGET_MULTIBYTE_P (bufp); + /* Failure point stack. Each place that can handle a failure further down the line pushes a failure point on this stack. It consists of regstart, and regend for all registers corresponding to @@ -5325,63 +5511,99 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) /* Remember the start point to rollback upon failure. */ dfail = d; +#ifndef emacs /* This is written out as an if-else so we don't waste time testing `translate' inside the loop. */ if (RE_TRANSLATE_P (translate)) - { - if (multibyte) - do + do + { + PREFETCH (); + if (RE_TRANSLATE (translate, *d) != *p++) { - int pat_charlen, buf_charlen; - unsigned int pat_ch, buf_ch; + d = dfail; + goto fail; + } + d++; + } + while (--mcnt); + else + do + { + PREFETCH (); + if (*d++ != *p++) + { + d = dfail; + goto fail; + } + } + while (--mcnt); +#else /* emacs */ + /* The cost of testing `translate' is comparatively small. */ + if (target_multibyte) + do + { + int pat_charlen, buf_charlen; + int pat_ch, buf_ch; - PREFETCH (); - pat_ch = STRING_CHAR_AND_LENGTH (p, pend - p, pat_charlen); - buf_ch = STRING_CHAR_AND_LENGTH (d, dend - d, buf_charlen); + PREFETCH (); + if (multibyte) + pat_ch = STRING_CHAR_AND_LENGTH (p, pend - p, pat_charlen); + else + { + pat_ch = RE_CHAR_TO_MULTIBYTE (*p); + pat_charlen = 1; + } + buf_ch = STRING_CHAR_AND_LENGTH (d, dend - d, buf_charlen); - if (RE_TRANSLATE (translate, buf_ch) - != pat_ch) - { - d = dfail; - goto fail; - } + if (TRANSLATE (buf_ch) != pat_ch) + { + d = dfail; + goto fail; + } + + p += pat_charlen; + d += buf_charlen; + mcnt -= pat_charlen; + } + while (mcnt > 0); + else + do + { + int pat_charlen, buf_charlen; + int pat_ch, buf_ch; - p += pat_charlen; - d += buf_charlen; - mcnt -= pat_charlen; + PREFETCH (); + if (multibyte) + { + pat_ch = STRING_CHAR_AND_LENGTH (p, pend - p, pat_charlen); + if (CHAR_BYTE8_P (pat_ch)) + pat_ch = CHAR_TO_BYTE8 (pat_ch); + else + pat_ch = RE_CHAR_TO_UNIBYTE (pat_ch); } - while (mcnt > 0); - else - do + else { - /* Avoid compiler whining about comparison being - always true. */ - int di; - - PREFETCH (); - di = *d; - if (RE_TRANSLATE (translate, di) != *p++) - { - d = dfail; - goto fail; - } - d++; + pat_ch = *p; + pat_charlen = 1; } - while (--mcnt); - } - else - { - do - { - PREFETCH (); - if (*d++ != *p++) - { - d = dfail; - goto fail; - } - } - while (--mcnt); - } + buf_ch = RE_CHAR_TO_MULTIBYTE (*d); + if (! CHAR_BYTE8_P (buf_ch)) + { + buf_ch = TRANSLATE (buf_ch); + buf_ch = RE_CHAR_TO_UNIBYTE (buf_ch); + if (buf_ch < 0) + buf_ch = *d; + } + if (buf_ch != pat_ch) + { + d = dfail; + goto fail; + } + p += pat_charlen; + d++; + } + while (--mcnt); +#endif break; @@ -5394,7 +5616,8 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) DEBUG_PRINT1 ("EXECUTING anychar.\n"); PREFETCH (); - buf_ch = RE_STRING_CHAR_AND_LENGTH (d, dend - d, buf_charlen); + buf_ch = RE_STRING_CHAR_AND_LENGTH (d, dend - d, buf_charlen, + target_multibyte); buf_ch = TRANSLATE (buf_ch); if ((!(bufp->syntax & RE_DOT_NEWLINE) @@ -5438,10 +5661,30 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) } PREFETCH (); - c = RE_STRING_CHAR_AND_LENGTH (d, dend - d, len); - c = TRANSLATE (c); /* The character to match. */ + c = RE_STRING_CHAR_AND_LENGTH (d, dend - d, len, target_multibyte); + if (target_multibyte) + { + int c1; - if (SINGLE_BYTE_CHAR_P (c)) + c = TRANSLATE (c); + c1 = RE_CHAR_TO_UNIBYTE (c); + if (c1 >= 0) + c = c1; + } + else + { + int c1 = RE_CHAR_TO_MULTIBYTE (c); + + if (! CHAR_BYTE8_P (c1)) + { + c1 = TRANSLATE (c1); + c1 = RE_CHAR_TO_UNIBYTE (c1); + if (c1 >= 0) + c = c1; + } + } + + if (c < (1 << BYTEWIDTH)) { /* Lookup bitmap. */ /* Cast to `unsigned' instead of `unsigned char' in case the bit list is a full 32 bytes long. */ @@ -5581,7 +5824,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) /* Compare that many; failure if mismatch, else move past them. */ if (RE_TRANSLATE_P (translate) - ? bcmp_translate (d, d2, mcnt, translate, multibyte) + ? bcmp_translate (d, d2, mcnt, translate, target_multibyte) : memcmp (d, d2, mcnt)) { d = dfail; @@ -5604,7 +5847,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) } else { - unsigned char c; + unsigned c; GET_CHAR_BEFORE_2 (c, d, string1, end1, string2, end2); if (c == '\n') break; @@ -5871,6 +6114,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) is the character at D, and S2 is the syntax of C2. */ re_wchar_t c1, c2; int s1, s2; + int dummy; #ifdef emacs int offset = PTR_TO_OFFSET (d - 1); int charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); @@ -5882,7 +6126,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); #endif PREFETCH_NOLIMIT (); - c2 = RE_STRING_CHAR (d, dend - d); + GET_CHAR_AFTER (c2, d, dummy); s2 = SYNTAX (c2); if (/* Case 2: Only one of S1 and S2 is Sword. */ @@ -5911,13 +6155,14 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) is the character at D, and S2 is the syntax of C2. */ re_wchar_t c1, c2; int s1, s2; + int dummy; #ifdef emacs int offset = PTR_TO_OFFSET (d); int charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); UPDATE_SYNTAX_TABLE (charpos); #endif PREFETCH (); - c2 = RE_STRING_CHAR (d, dend - d); + GET_CHAR_AFTER (c2, d, dummy); s2 = SYNTAX (c2); /* Case 2: S2 is not Sword. */ @@ -5955,6 +6200,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) is the character at D, and S2 is the syntax of C2. */ re_wchar_t c1, c2; int s1, s2; + int dummy; #ifdef emacs int offset = PTR_TO_OFFSET (d) - 1; int charpos = SYNTAX_TABLE_BYTE_TO_CHAR (offset); @@ -5971,9 +6217,9 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) if (!AT_STRINGS_END (d)) { PREFETCH_NOLIMIT (); - c2 = RE_STRING_CHAR (d, dend - d); + GET_CHAR_AFTER (c2, d, dummy); #ifdef emacs - UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); + UPDATE_SYNTAX_TABLE_FORWARD (charpos); #endif s2 = SYNTAX (c2); @@ -6005,7 +6251,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) UPDATE_SYNTAX_TABLE (charpos); #endif PREFETCH (); - c2 = RE_STRING_CHAR (d, dend - d); + c2 = RE_STRING_CHAR (d, dend - d, target_multibyte); s2 = SYNTAX (c2); /* Case 2: S2 is neither Sword nor Ssymbol. */ @@ -6058,7 +6304,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) if (!AT_STRINGS_END (d)) { PREFETCH_NOLIMIT (); - c2 = RE_STRING_CHAR (d, dend - d); + c2 = RE_STRING_CHAR (d, dend - d, target_multibyte); #ifdef emacs UPDATE_SYNTAX_TABLE_FORWARD (charpos + 1); #endif @@ -6088,8 +6334,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) int len; re_wchar_t c; - c = RE_STRING_CHAR_AND_LENGTH (d, dend - d, len); - + GET_CHAR_AFTER (c, d, len); if ((SYNTAX (c) != (enum syntaxcode) mcnt) ^ not) goto fail; d += len; @@ -6125,8 +6370,7 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) int len; re_wchar_t c; - c = RE_STRING_CHAR_AND_LENGTH (d, dend - d, len); - + GET_CHAR_AFTER (c, d, len); if ((!CHAR_HAS_CATEGORY (c, mcnt)) ^ not) goto fail; d += len; @@ -6201,11 +6445,11 @@ re_match_2_internal (bufp, string1, size1, string2, size2, pos, regs, stop) bytes; nonzero otherwise. */ static int -bcmp_translate (s1, s2, len, translate, multibyte) +bcmp_translate (s1, s2, len, translate, target_multibyte) re_char *s1, *s2; register int len; RE_TRANSLATE_TYPE translate; - const int multibyte; + const int target_multibyte; { register re_char *p1 = s1, *p2 = s2; re_char *p1_end = s1 + len; @@ -6218,8 +6462,8 @@ bcmp_translate (s1, s2, len, translate, multibyte) int p1_charlen, p2_charlen; re_wchar_t p1_ch, p2_ch; - p1_ch = RE_STRING_CHAR_AND_LENGTH (p1, p1_end - p1, p1_charlen); - p2_ch = RE_STRING_CHAR_AND_LENGTH (p2, p2_end - p2, p2_charlen); + GET_CHAR_AFTER (p1_ch, p1, p1_charlen); + GET_CHAR_AFTER (p2_ch, p2, p2_charlen); if (RE_TRANSLATE (translate, p1_ch) != RE_TRANSLATE (translate, p2_ch)) diff --git a/src/regex.h b/src/regex.h index 580b1369489..69127efa576 100644 --- a/src/regex.h +++ b/src/regex.h @@ -398,9 +398,16 @@ struct re_pattern_buffer unsigned used_syntax : 1; #ifdef emacs - /* If true, multi-byte form in the `buffer' should be recognized as a - multibyte character. */ + /* If true, multi-byte form in the regexp pattern should be + recognized as a multibyte character. */ unsigned multibyte : 1; + + /* If true, multi-byte form in the target of match should be + recognized as a multibyte character. */ + unsigned target_multibyte : 1; + + /* Charset of unibyte characters at compiling time. */ + int charset_unibyte; #endif /* [[[end pattern_buffer]]] */ diff --git a/src/search.c b/src/search.c index 3c91d3cce92..2060abda6d7 100644 --- a/src/search.c +++ b/src/search.c @@ -25,6 +25,7 @@ Boston, MA 02110-1301, USA. */ #include "syntax.h" #include "category.h" #include "buffer.h" +#include "character.h" #include "charset.h" #include "region-cache.h" #include "commands.h" @@ -120,61 +121,25 @@ matcher_overflow () subexpression bounds. POSIX is nonzero if we want full backtracking (POSIX style) for this pattern. 0 means backtrack only enough to get a valid match. - MULTIBYTE is nonzero if we want to handle multibyte characters in - PATTERN. 0 means all multibyte characters are recognized just as - sequences of binary data. The behavior also depends on Vsearch_spaces_regexp. */ static void -compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte) +compile_pattern_1 (cp, pattern, translate, regp, posix) struct regexp_cache *cp; Lisp_Object pattern; Lisp_Object translate; struct re_registers *regp; int posix; - int multibyte; { - unsigned char *raw_pattern; - int raw_pattern_size; char *val; reg_syntax_t old; - /* MULTIBYTE says whether the text to be searched is multibyte. - We must convert PATTERN to match that, or we will not really - find things right. */ - - if (multibyte == STRING_MULTIBYTE (pattern)) - { - raw_pattern = (unsigned char *) SDATA (pattern); - raw_pattern_size = SBYTES (pattern); - } - else if (multibyte) - { - raw_pattern_size = count_size_as_multibyte (SDATA (pattern), - SCHARS (pattern)); - raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1); - copy_text (SDATA (pattern), raw_pattern, - SCHARS (pattern), 0, 1); - } - else - { - /* Converting multibyte to single-byte. - - ??? Perhaps this conversion should be done in a special way - by subtracting nonascii-insert-offset from each non-ASCII char, - so that only the multibyte chars which really correspond to - the chosen single-byte character set can possibly match. */ - raw_pattern_size = SCHARS (pattern); - raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1); - copy_text (SDATA (pattern), raw_pattern, - SBYTES (pattern), 1, 0); - } - cp->regexp = Qnil; cp->buf.translate = (! NILP (translate) ? translate : make_number (0)); cp->posix = posix; - cp->buf.multibyte = multibyte; + cp->buf.multibyte = STRING_MULTIBYTE (pattern); + cp->buf.charset_unibyte = charset_unibyte; cp->whitespace_regexp = Vsearch_spaces_regexp; /* rms: I think BLOCK_INPUT is not needed here any more, because regex.c defines malloc to call xmalloc. @@ -183,12 +148,11 @@ compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte) /* BLOCK_INPUT; */ old = re_set_syntax (RE_SYNTAX_EMACS | (posix ? 0 : RE_NO_POSIX_BACKTRACKING)); - re_set_whitespace_regexp (NILP (Vsearch_spaces_regexp) ? NULL : SDATA (Vsearch_spaces_regexp)); - val = (char *) re_compile_pattern ((char *)raw_pattern, - raw_pattern_size, &cp->buf); + val = (char *) re_compile_pattern ((char *) SDATA (pattern), + SBYTES (pattern), &cp->buf); /* If the compiled pattern hard codes some of the contents of the syntax-table, it can only be reused with *this* syntax table. */ @@ -274,10 +238,10 @@ compile_pattern (pattern, regp, translate, posix, multibyte) && !NILP (Fstring_equal (cp->regexp, pattern)) && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) && cp->posix == posix - && cp->buf.multibyte == multibyte && (EQ (cp->syntax_table, Qt) || EQ (cp->syntax_table, current_buffer->syntax_table)) - && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp))) + && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp)) + && cp->buf.charset_unibyte == charset_unibyte) break; /* If we're at the end of the cache, compile into the nil cell @@ -286,7 +250,7 @@ compile_pattern (pattern, regp, translate, posix, multibyte) if (cp->next == 0) { compile_it: - compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte); + compile_pattern_1 (cp, pattern, translate, regp, posix); break; } } @@ -303,6 +267,10 @@ compile_pattern (pattern, regp, translate, posix, multibyte) if (regp) re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end); + /* The compiled pattern can be used both for mulitbyte and unibyte + target. But, we have to tell which the pattern is used for. */ + cp->buf.target_multibyte = multibyte; + return &cp->buf; } @@ -1264,7 +1232,7 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, unsigned char *base_pat; /* Set to positive if we find a non-ASCII char that need translation. Otherwise set to zero later. */ - int charset_base = -1; + int char_base = -1; int boyer_moore_ok = 1; /* MULTIBYTE says whether the text to be searched is multibyte. @@ -1305,7 +1273,7 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, /* Copy and optionally translate the pattern. */ len = raw_pattern_size; len_byte = raw_pattern_size_byte; - patbuf = (unsigned char *) alloca (len_byte); + patbuf = (unsigned char *) alloca (len * MAX_MULTIBYTE_LENGTH); pat = patbuf; base_pat = raw_pattern; if (multibyte) @@ -1355,46 +1323,47 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, if (c != inverse && boyer_moore_ok) { /* Check if all equivalents belong to the same - charset & row. Note that the check of C - itself is done by the last iteration. Note - also that we don't have to check ASCII - characters because boyer-moore search can - always handle their translation. */ - while (1) + group of characters. Note that the check of C + itself is done by the last iteration. */ + int this_char_base = -1; + + while (boyer_moore_ok) { if (ASCII_BYTE_P (inverse)) { - if (charset_base > 0) + if (this_char_base > 0) + boyer_moore_ok = 0; + else { - boyer_moore_ok = 0; - break; + this_char_base = 0; + if (char_base < 0) + char_base = this_char_base; } - charset_base = 0; - } - else if (SINGLE_BYTE_CHAR_P (inverse)) - { - /* Boyer-moore search can't handle a - translation of an eight-bit - character. */ - boyer_moore_ok = 0; - break; } - else if (charset_base < 0) - charset_base = inverse & ~CHAR_FIELD3_MASK; - else if ((inverse & ~CHAR_FIELD3_MASK) - != charset_base) + else if (CHAR_BYTE8_P (inverse)) + /* Boyer-moore search can't handle a + translation of an eight-bit + character. */ + boyer_moore_ok = 0; + else if (this_char_base < 0) { - boyer_moore_ok = 0; - break; + this_char_base = inverse & ~0x3F; + if (char_base < 0) + char_base = this_char_base; + else if (char_base > 0 + && this_char_base != char_base) + boyer_moore_ok = 0; } + else if ((inverse & ~0x3F) != this_char_base) + boyer_moore_ok = 0; if (c == inverse) break; TRANSLATE (inverse, inverse_trt, inverse); } } } - if (charset_base < 0) - charset_base = 0; + if (char_base < 0) + char_base = 0; /* Store this character into the translated pattern. */ bcopy (str, pat, charlen); @@ -1406,7 +1375,7 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, else { /* Unibyte buffer. */ - charset_base = 0; + char_base = 0; while (--len >= 0) { int c, translated; @@ -1433,7 +1402,7 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, if (boyer_moore_ok) return boyer_moore (n, pat, len, len_byte, trt, inverse_trt, pos, pos_byte, lim, lim_byte, - charset_base); + char_base); else return simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte); @@ -1463,6 +1432,9 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) { int multibyte = ! NILP (current_buffer->enable_multibyte_characters); int forward = n > 0; + /* Number of buffer bytes matched. Note that this may be different + from len_byte in a multibyte buffer. */ + int match_byte; if (lim > pos && multibyte) while (n > 0) @@ -1475,7 +1447,7 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) int this_len = len; int this_len_byte = len_byte; unsigned char *p = pat; - if (pos + len > lim) + if (pos + len > lim || pos_byte + len_byte > lim_byte) goto stop; while (this_len > 0) @@ -1502,8 +1474,9 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) if (this_len == 0) { + match_byte = this_pos_byte - pos_byte; pos += len; - pos_byte += len_byte; + pos_byte += match_byte; break; } @@ -1540,6 +1513,7 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) if (this_len == 0) { + match_byte = len; pos += len; break; } @@ -1557,13 +1531,15 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) { /* Try matching at position POS. */ int this_pos = pos - len; - int this_pos_byte = pos_byte - len_byte; + int this_pos_byte; int this_len = len; int this_len_byte = len_byte; unsigned char *p = pat; - if (this_pos < lim || this_pos_byte < lim_byte) + if (this_pos < lim || (pos_byte - len_byte) < lim_byte) goto stop; + this_pos_byte = CHAR_TO_BYTE (this_pos); + match_byte = pos_byte - this_pos_byte; while (this_len > 0) { @@ -1589,7 +1565,7 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) if (this_len == 0) { pos -= len; - pos_byte -= len_byte; + pos_byte -= match_byte; break; } @@ -1608,7 +1584,7 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) int this_len = len; unsigned char *p = pat; - if (pos - len < lim) + if (this_pos < lim) goto stop; while (this_len > 0) @@ -1625,6 +1601,7 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) if (this_len == 0) { + match_byte = len; pos -= len; break; } @@ -1639,9 +1616,9 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) if (n == 0) { if (forward) - set_search_regs ((multibyte ? pos_byte : pos) - len_byte, len_byte); + set_search_regs ((multibyte ? pos_byte : pos) - match_byte, match_byte); else - set_search_regs (multibyte ? pos_byte : pos, len_byte); + set_search_regs (multibyte ? pos_byte : pos, match_byte); return pos; } @@ -1662,13 +1639,13 @@ simple_search (n, pat, len, len_byte, trt, pos, pos_byte, lim, lim_byte) have nontrivial translation are the same aside from the last byte. This makes it possible to translate just the last byte of a character, and do so after just a simple test of the context. - CHARSET_BASE is nonzero if there is such a non-ASCII character. + CHAR_BASE is nonzero if there is such a non-ASCII character. If that criterion is not satisfied, do not call this function. */ static int boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, - pos, pos_byte, lim, lim_byte, charset_base) + pos, pos_byte, lim, lim_byte, char_base) int n; unsigned char *base_pat; int len, len_byte; @@ -1676,7 +1653,7 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, Lisp_Object inverse_trt; int pos, pos_byte; int lim, lim_byte; - int charset_base; + int char_base; { int direction = ((n > 0) ? 1 : -1); register int dirlen; @@ -1690,12 +1667,13 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, unsigned char simple_translate[0400]; /* These are set to the preceding bytes of a byte to be translated - if charset_base is nonzero. As the maximum byte length of a - multibyte character is 4, we have to check at most three previous + if char_base is nonzero. As the maximum byte length of a + multibyte character is 5, we have to check at most four previous bytes. */ int translate_prev_byte1 = 0; int translate_prev_byte2 = 0; int translate_prev_byte3 = 0; + int translate_prev_byte4 = 0; BM_tab = (int *) alloca (0400 * sizeof (int)); @@ -1757,20 +1735,23 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, for (i = 0; i < 0400; i++) simple_translate[i] = i; - if (charset_base) + if (char_base) { - /* Setup translate_prev_byte1/2/3 from CHARSET_BASE. Only a + /* Setup translate_prev_byte1/2/3/4 from CHAR_BASE. Only a byte following them are the target of translation. */ - int sample_char = charset_base | 0x20; unsigned char str[MAX_MULTIBYTE_LENGTH]; - int len = CHAR_STRING (sample_char, str); + int len = CHAR_STRING (char_base, str); translate_prev_byte1 = str[len - 2]; if (len > 2) { translate_prev_byte2 = str[len - 3]; if (len > 3) - translate_prev_byte3 = str[len - 4]; + { + translate_prev_byte3 = str[len - 4]; + if (len > 4) + translate_prev_byte4 = str[len - 5]; + } } } @@ -1786,12 +1767,12 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, /* If the byte currently looking at is the last of a character to check case-equivalents, set CH to that character. An ASCII character and a non-ASCII character - matching with CHARSET_BASE are to be checked. */ + matching with CHAR_BASE are to be checked. */ int ch = -1; if (ASCII_BYTE_P (*ptr) || ! multibyte) ch = *ptr; - else if (charset_base + else if (char_base && ((pat_end - ptr) == 1 || CHAR_HEAD_P (ptr[1]))) { unsigned char *charstart = ptr - 1; @@ -1799,12 +1780,12 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, while (! (CHAR_HEAD_P (*charstart))) charstart--; ch = STRING_CHAR (charstart, ptr - charstart + 1); - if (charset_base != (ch & ~CHAR_FIELD3_MASK)) + if (char_base != (ch & ~0x3F)) ch = -1; } if (ch >= 0400) - j = ((unsigned char) ch) | 0200; + j = (ch & 0x3F) | 0200; else j = *ptr; @@ -1823,9 +1804,9 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, { TRANSLATE (ch, inverse_trt, ch); if (ch >= 0400) - j = ((unsigned char) ch) | 0200; + j = (ch & 0x3F) | 0200; else - j = (unsigned char) ch; + j = ch; /* For all the characters that map into CH, set up simple_translate to map the last byte @@ -2152,7 +2133,7 @@ wordify (string) { int c; - FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte); + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte); if (SYNTAX (c) != Sword) { @@ -2187,7 +2168,7 @@ wordify (string) int c; int i_byte_orig = i_byte; - FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte); + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte); if (SYNTAX (c) == Sword) { @@ -2471,11 +2452,11 @@ since only regular expressions have distinguished subexpressions. */) { if (NILP (string)) { - c = FETCH_CHAR (pos_byte); + c = FETCH_CHAR_AS_MULTIBYTE (pos_byte); INC_BOTH (pos, pos_byte); } else - FETCH_STRING_CHAR_ADVANCE (c, string, pos, pos_byte); + FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte); if (LOWERCASEP (c)) { @@ -2647,10 +2628,7 @@ since only regular expressions have distinguished subexpressions. */) Lisp_Object rev_tbl; int really_changed = 0; - rev_tbl= (!buf_multibyte && CHAR_TABLE_P (Vnonascii_translation_table) - ? Fchar_table_extra_slot (Vnonascii_translation_table, - make_number (0)) - : Qnil); + rev_tbl = Qnil; substed_alloc_size = length * 2 + 100; substed = (unsigned char *) xmalloc (substed_alloc_size + 1); @@ -2693,7 +2671,7 @@ since only regular expressions have distinguished subexpressions. */) { FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte); - if (!buf_multibyte && !SINGLE_BYTE_CHAR_P (c)) + if (!buf_multibyte && !ASCII_CHAR_P (c)) c = multibyte_char_to_unibyte (c, rev_tbl); } else diff --git a/src/syntax.c b/src/syntax.c index 4afaeda82db..c6cc8da0785 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -26,7 +26,7 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "commands.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "keymap.h" #include "regex.h" @@ -101,7 +101,8 @@ static int find_defun_start P_ ((int, int)); static int back_comment P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int, int, EMACS_INT *, EMACS_INT *)); static int char_quoted P_ ((int, int)); -static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object, int)); +static Lisp_Object skip_chars P_ ((int, Lisp_Object, Lisp_Object, int)); +static Lisp_Object skip_syntaxes P_ ((int, Lisp_Object, Lisp_Object)); static Lisp_Object scan_lists P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int)); static void scan_sexps_forward P_ ((struct lisp_parse_state *, int, int, int, int, @@ -306,7 +307,7 @@ char_quoted (charpos, bytepos) int c; UPDATE_SYNTAX_TABLE_BACKWARD (charpos); - c = FETCH_CHAR (bytepos); + c = FETCH_CHAR_AS_MULTIBYTE (bytepos); code = SYNTAX (c); if (! (code == Scharquote || code == Sescape)) break; @@ -398,11 +399,11 @@ find_defun_start (pos, pos_byte) /* Open-paren at start of line means we may have found our defun-start. */ - c = FETCH_CHAR (PT_BYTE); + c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE); if (SYNTAX (c) == Sopen) { SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */ - c = FETCH_CHAR (PT_BYTE); + c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE); if (SYNTAX (c) == Sopen) break; /* Now fallback to the default value. */ @@ -523,7 +524,7 @@ back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_p UPDATE_SYNTAX_TABLE_BACKWARD (from); prev_syntax = syntax; - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); syntax = SYNTAX_WITH_FLAGS (c); code = SYNTAX (c); @@ -552,7 +553,7 @@ back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_p int next = from, next_byte = from_byte, next_c, next_syntax; DEC_BOTH (next, next_byte); UPDATE_SYNTAX_TABLE_BACKWARD (next); - next_c = FETCH_CHAR (next_byte); + next_c = FETCH_CHAR_AS_MULTIBYTE (next_byte); next_syntax = SYNTAX_WITH_FLAGS (next_c); if (((com2start || comnested) && SYNTAX_FLAGS_COMEND_SECOND (syntax) @@ -855,29 +856,6 @@ char syntax_code_spec[16] = static Lisp_Object Vsyntax_code_object; -/* Look up the value for CHARACTER in syntax table TABLE's parent - and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil - for CHARACTER. It's actually used only when not compiled with GCC. */ - -Lisp_Object -syntax_parent_lookup (table, character) - Lisp_Object table; - int character; -{ - Lisp_Object value; - - while (1) - { - table = XCHAR_TABLE (table)->parent; - if (NILP (table)) - return Qnil; - - value = XCHAR_TABLE (table)->contents[character]; - if (!NILP (value)) - return value; - } -} - DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0, doc: /* Return the syntax code of CHARACTER, described by a character. For example, if CHARACTER is a word constituent, @@ -996,6 +974,8 @@ DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3, doc: /* Set syntax for character CHAR according to string NEWENTRY. The syntax is changed only for table SYNTAX-TABLE, which defaults to the current buffer's syntax table. +CHAR may be a cons (MIN . MAX), in which case, syntaxes of all characters +in the range MIN and MAX are changed. The first character of NEWENTRY should be one of the following: Space or - whitespace syntax. w word constituent. _ symbol constituent. . punctuation. @@ -1032,14 +1012,24 @@ usage: (modify-syntax-entry CHAR NEWENTRY &optional SYNTAX-TABLE) */) (c, newentry, syntax_table) Lisp_Object c, newentry, syntax_table; { - CHECK_NUMBER (c); + if (CONSP (c)) + { + CHECK_CHARACTER_CAR (c); + CHECK_CHARACTER_CDR (c); + } + else + CHECK_CHARACTER (c); if (NILP (syntax_table)) syntax_table = current_buffer->syntax_table; else check_syntax_table (syntax_table); - SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), Fstring_to_syntax (newentry)); + newentry = Fstring_to_syntax (newentry); + if (CONSP (c)) + SET_RAW_SYNTAX_ENTRY_RANGE (syntax_table, c, newentry); + else + SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), newentry); /* We clear the regexp cache, since character classes can now have different values from those in the compiled regexps.*/ @@ -1198,6 +1188,10 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, int parse_sexp_ignore_comments; +/* Char-table of functions that find the next or previous word + boundary. */ +Lisp_Object Vfind_word_boundary_function_table; + /* Return the position across COUNT words from FROM. If that many words cannot be found before the end of the buffer, return 0. COUNT negative means scan backward and stop at word beginning. */ @@ -1211,6 +1205,7 @@ scan_words (from, count) register int from_byte = CHAR_TO_BYTE (from); register enum syntaxcode code; int ch0, ch1; + Lisp_Object func, script, pos; immediate_quit = 1; QUIT; @@ -1227,7 +1222,7 @@ scan_words (from, count) return 0; } UPDATE_SYNTAX_TABLE_FORWARD (from); - ch0 = FETCH_CHAR (from_byte); + ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX (ch0); INC_BOTH (from, from_byte); if (words_include_escapes @@ -1238,18 +1233,33 @@ scan_words (from, count) } /* Now CH0 is a character which begins a word and FROM is the position of the next character. */ - while (1) + func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch0); + if (! NILP (Ffboundp (func))) { - if (from == end) break; - UPDATE_SYNTAX_TABLE_FORWARD (from); - ch1 = FETCH_CHAR (from_byte); - code = SYNTAX (ch1); - if (!(words_include_escapes - && (code == Sescape || code == Scharquote))) - if (code != Sword || WORD_BOUNDARY_P (ch0, ch1)) - break; - INC_BOTH (from, from_byte); - ch0 = ch1; + pos = call2 (func, make_number (from - 1), make_number (end)); + if (INTEGERP (pos) && XINT (pos) > from) + { + from = XINT (pos); + from_byte = CHAR_TO_BYTE (from); + } + } + else + { + script = CHAR_TABLE_REF (Vchar_script_table, ch0); + while (1) + { + if (from == end) break; + UPDATE_SYNTAX_TABLE_FORWARD (from); + ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); + code = SYNTAX (ch1); + if ((code != Sword + && (! words_include_escapes + || (code != Sescape && code != Scharquote))) + || ! EQ (CHAR_TABLE_REF (Vchar_script_table, ch1), script)) + break; + INC_BOTH (from, from_byte); + ch0 = ch1; + } } count--; } @@ -1264,7 +1274,7 @@ scan_words (from, count) } DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); - ch1 = FETCH_CHAR (from_byte); + ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX (ch1); if (words_include_escapes && (code == Sescape || code == Scharquote)) @@ -1274,22 +1284,37 @@ scan_words (from, count) } /* Now CH1 is a character which ends a word and FROM is the position of it. */ - while (1) + func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch1); + if (! NILP (Ffboundp (func))) + { + pos = call2 (func, make_number (from), make_number (beg)); + if (INTEGERP (pos) && XINT (pos) < from) + { + from = XINT (pos); + from_byte = CHAR_TO_BYTE (from); + } + } + else { - if (from == beg) - break; - DEC_BOTH (from, from_byte); - UPDATE_SYNTAX_TABLE_BACKWARD (from); - ch0 = FETCH_CHAR (from_byte); - code = SYNTAX (ch0); - if (!(words_include_escapes - && (code == Sescape || code == Scharquote))) - if (code != Sword || WORD_BOUNDARY_P (ch0, ch1)) - { - INC_BOTH (from, from_byte); + script = CHAR_TABLE_REF (Vchar_script_table, ch1); + while (1) + { + if (from == beg) break; - } - ch1 = ch0; + DEC_BOTH (from, from_byte); + UPDATE_SYNTAX_TABLE_BACKWARD (from); + ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte); + code = SYNTAX (ch0); + if ((code != Sword + && (! words_include_escapes + || (code != Sescape && code != Scharquote))) + || ! EQ (CHAR_TABLE_REF (Vchar_script_table, ch0), script)) + { + INC_BOTH (from, from_byte); + break; + } + ch1 = ch0; + } } count++; } @@ -1344,7 +1369,7 @@ Returns the distance traveled, either zero or positive. */) (string, lim) Lisp_Object string, lim; { - return skip_chars (1, 0, string, lim, 1); + return skip_chars (1, string, lim, 1); } DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0, @@ -1354,7 +1379,7 @@ Returns the distance traveled, either zero or negative. */) (string, lim) Lisp_Object string, lim; { - return skip_chars (0, 0, string, lim, 1); + return skip_chars (0, string, lim, 1); } DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0, @@ -1366,7 +1391,7 @@ This function returns the distance traveled, either zero or positive. */) (syntax, lim) Lisp_Object syntax, lim; { - return skip_chars (1, 1, syntax, lim, 0); + return skip_syntaxes (1, syntax, lim); } DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0, @@ -1378,25 +1403,27 @@ This function returns the distance traveled, either zero or negative. */) (syntax, lim) Lisp_Object syntax, lim; { - return skip_chars (0, 1, syntax, lim, 0); + return skip_syntaxes (0, syntax, lim); } static Lisp_Object -skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes) - int forwardp, syntaxp; +skip_chars (forwardp, string, lim, handle_iso_classes) + int forwardp; Lisp_Object string, lim; int handle_iso_classes; { register unsigned int c; unsigned char fastmap[0400]; - /* If SYNTAXP is 0, STRING may contain multi-byte form of characters - of which codes don't fit in FASTMAP. In that case, set the - ranges of characters in CHAR_RANGES. */ + /* Store the ranges of non-ASCII characters. */ int *char_ranges; int n_char_ranges = 0; int negate = 0; register int i, i_byte; - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + /* Set to 1 if the current buffer is multibyte and the region + contains non-ASCII chars. */ + int multibyte; + /* Set to 1 if STRING is multibyte and it contains non-ASCII + chars. */ int string_multibyte; int size_byte; const unsigned char *str; @@ -1404,32 +1431,8 @@ skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes) Lisp_Object iso_classes; CHECK_STRING (string); - char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2); - string_multibyte = STRING_MULTIBYTE (string); - str = SDATA (string); - size_byte = SBYTES (string); iso_classes = Qnil; - /* Adjust the multibyteness of the string to that of the buffer. */ - if (multibyte != string_multibyte) - { - int nbytes; - - if (multibyte) - nbytes = count_size_as_multibyte (SDATA (string), - SCHARS (string)); - else - nbytes = SCHARS (string); - if (nbytes != size_byte) - { - unsigned char *tmp = (unsigned char *) alloca (nbytes); - copy_text (SDATA (string), tmp, size_byte, - string_multibyte, multibyte); - size_byte = nbytes; - str = tmp; - } - } - if (NILP (lim)) XSETINT (lim, forwardp ? ZV : BEGV); else @@ -1441,10 +1444,16 @@ skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes) if (XINT (lim) < BEGV) XSETFASTINT (lim, BEGV); + multibyte = (!NILP (current_buffer->enable_multibyte_characters) + && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); + string_multibyte = SBYTES (string) > SCHARS (string); + bzero (fastmap, sizeof fastmap); - i_byte = 0; + str = SDATA (string); + size_byte = SBYTES (string); + i_byte = 0; if (i_byte < size_byte && SREF (string, 0) == '^') { @@ -1452,21 +1461,23 @@ skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes) } /* Find the characters specified and set their elements of fastmap. - If syntaxp, each character counts as itself. - Otherwise, handle backslashes and ranges specially. */ + Handle backslashes and ranges specially. - while (i_byte < size_byte) + If STRING contains non-ASCII characters, setup char_ranges for + them and use fastmap only for their leading codes. */ + + if (! string_multibyte) { - c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte - i_byte, len); - i_byte += len; + int string_has_eight_bit = 0; - if (syntaxp) - fastmap[syntax_spec_code[c & 0377]] = 1; - else + /* At first setup fastmap. */ + while (i_byte < size_byte) { + c = str[i_byte++]; + if (handle_iso_classes && c == '[' && i_byte < size_byte - && STRING_CHAR (str + i_byte, size_byte - i_byte) == ':') + && str[i_byte] == ':') { const unsigned char *class_beg = str + i_byte + 1; const unsigned char *class_end = class_beg; @@ -1505,6 +1516,129 @@ skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes) if (i_byte == size_byte) break; + c = str[i_byte++]; + } + /* Treat `-' as range character only if another character + follows. */ + if (i_byte + 1 < size_byte + && str[i_byte] == '-') + { + unsigned int c2; + + /* Skip over the dash. */ + i_byte++; + + /* Get the end of the range. */ + c2 = str[i_byte++]; + if (c2 == '\\' + && i_byte < size_byte) + c2 = str[i_byte++]; + + if (c <= c2) + { + while (c <= c2) + fastmap[c++] = 1; + if (! ASCII_CHAR_P (c2)) + string_has_eight_bit = 1; + } + } + else + { + fastmap[c] = 1; + if (! ASCII_CHAR_P (c)) + string_has_eight_bit = 1; + } + } + + /* If the current range is multibyte and STRING contains + eight-bit chars, arrange fastmap and setup char_ranges for + the corresponding multibyte chars. */ + if (multibyte && string_has_eight_bit) + { + unsigned char fastmap2[0400]; + int range_start_byte, range_start_char; + + bcopy (fastmap2 + 0200, fastmap + 0200, 0200); + bzero (fastmap + 0200, 0200); + /* We are sure that this loop stops. */ + for (i = 0200; ! fastmap2[i]; i++); + c = unibyte_char_to_multibyte (i); + fastmap[CHAR_LEADING_CODE (c)] = 1; + range_start_byte = i; + range_start_char = c; + char_ranges = (int *) alloca (sizeof (int) * 128 * 2); + for (i = 129; i < 0400; i++) + { + c = unibyte_char_to_multibyte (i); + fastmap[CHAR_LEADING_CODE (c)] = 1; + if (i - range_start_byte != c - range_start_char) + { + char_ranges[n_char_ranges++] = range_start_char; + char_ranges[n_char_ranges++] = ((i - 1 - range_start_byte) + + range_start_char); + range_start_byte = i; + range_start_char = c; + } + } + char_ranges[n_char_ranges++] = range_start_char; + char_ranges[n_char_ranges++] = ((i - 1 - range_start_byte) + + range_start_char); + } + } + else /* STRING is multibyte */ + { + char_ranges = (int *) alloca (sizeof (int) * SCHARS (string) * 2); + + while (i_byte < size_byte) + { + unsigned char leading_code; + + leading_code = str[i_byte]; + c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte-i_byte, len); + i_byte += len; + + if (handle_iso_classes && c == '[' + && i_byte < size_byte + && STRING_CHAR (str + i_byte, size_byte - i_byte) == ':') + { + const unsigned char *class_beg = str + i_byte + 1; + const unsigned char *class_end = class_beg; + const unsigned char *class_limit = str + size_byte - 2; + /* Leave room for the null. */ + unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1]; + re_wctype_t cc; + + if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH) + class_limit = class_beg + CHAR_CLASS_MAX_LENGTH; + + while (class_end < class_limit + && *class_end >= 'a' && *class_end <= 'z') + class_end++; + + if (class_end == class_beg + || *class_end != ':' || class_end[1] != ']') + goto not_a_class_name_multibyte; + + bcopy (class_beg, class_name, class_end - class_beg); + class_name[class_end - class_beg] = 0; + + cc = re_wctype (class_name); + if (cc == 0) + error ("Invalid ISO C character class"); + + iso_classes = Fcons (make_number (cc), iso_classes); + + i_byte = class_end + 2 - str; + continue; + } + + not_a_class_name_multibyte: + if (c == '\\') + { + if (i_byte == size_byte) + break; + + leading_code = str[i_byte]; c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte - i_byte, len); i_byte += len; @@ -1515,61 +1649,90 @@ skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes) && str[i_byte] == '-') { unsigned int c2; + unsigned char leading_code2; /* Skip over the dash. */ i_byte++; /* Get the end of the range. */ + leading_code2 = str[i_byte]; c2 = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte - i_byte, len); i_byte += len; - if (SINGLE_BYTE_CHAR_P (c)) + if (c2 == '\\' + && i_byte < size_byte) + { + leading_code2 = str[i_byte]; + c2 =STRING_CHAR_AND_LENGTH (str + i_byte, size_byte-i_byte, len); + i_byte += len; + } + + if (c > c2) + continue; + if (ASCII_CHAR_P (c)) + { + while (c <= c2 && c < 0x80) + fastmap[c++] = 1; + leading_code = CHAR_LEADING_CODE (c); + } + if (! ASCII_CHAR_P (c)) { - if (! SINGLE_BYTE_CHAR_P (c2)) + while (leading_code <= leading_code2) + fastmap[leading_code++] = 1; + if (c <= c2) { - /* Handle a range starting with a character of - less than 256, and ending with a character of - not less than 256. Split that into two - ranges, the low one ending at 0377, and the - high one starting at the smallest character - in the charset of C2 and ending at C2. */ - int charset = CHAR_CHARSET (c2); - int c1 = MAKE_CHAR (charset, 0, 0); - - char_ranges[n_char_ranges++] = c1; + char_ranges[n_char_ranges++] = c; char_ranges[n_char_ranges++] = c2; - c2 = 0377; } - while (c <= c2) - { - fastmap[c] = 1; - c++; - } - } - else if (c <= c2) /* Both C and C2 are multibyte char. */ - { - char_ranges[n_char_ranges++] = c; - char_ranges[n_char_ranges++] = c2; } } else { - if (SINGLE_BYTE_CHAR_P (c)) + if (ASCII_CHAR_P (c)) fastmap[c] = 1; else { + fastmap[leading_code] = 1; char_ranges[n_char_ranges++] = c; char_ranges[n_char_ranges++] = c; } } } + + /* If the current range is unibyte and STRING contains non-ASCII + chars, arrange fastmap for the corresponding unibyte + chars. */ + + if (! multibyte && n_char_ranges > 0) + { + bzero (fastmap + 0200, 0200); + for (i = 0; i < n_char_ranges; i += 2) + { + int c1 = char_ranges[i]; + int c2 = char_ranges[i + 1]; + + for (; c1 <= c2; c1++) + fastmap[CHAR_TO_BYTE8 (c1)] = 1; + } + } } /* If ^ was the first character, complement the fastmap. */ if (negate) - for (i = 0; i < sizeof fastmap; i++) - fastmap[i] ^= 1; + { + if (! multibyte) + for (i = 0; i < sizeof fastmap; i++) + fastmap[i] ^= 1; + else + { + for (i = 0; i < 0200; i++) + fastmap[i] ^= 1; + /* All non-ASCII chars possibly match. */ + for (; i < sizeof fastmap; i++) + fastmap[i] = 1; + } + } { int start_point = PT; @@ -1589,254 +1752,312 @@ skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes) } immediate_quit = 1; - if (syntaxp) + if (forwardp) { - SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); - if (forwardp) - { - if (multibyte) - while (1) - { - int nbytes; + if (multibyte) + while (1) + { + int nbytes; - if (p >= stop) - { - if (p >= endp) - break; - p = GAP_END_ADDR; - stop = endp; - } - c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes); - if (! fastmap[(int) SYNTAX (c)]) + if (p >= stop) + { + if (p >= endp) break; - p += nbytes, pos++, pos_byte += nbytes; - UPDATE_SYNTAX_TABLE_FORWARD (pos); + p = GAP_END_ADDR; + stop = endp; } - else - while (1) + c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes); + if (! NILP (iso_classes) && in_classes (c, iso_classes)) { - if (p >= stop) - { - if (p >= endp) - break; - p = GAP_END_ADDR; - stop = endp; - } - if (! fastmap[(int) SYNTAX (*p)]) + if (negate) break; - p++, pos++; - UPDATE_SYNTAX_TABLE_FORWARD (pos); + else + goto fwd_ok; } - } - else - { - if (multibyte) - while (1) - { - unsigned char *prev_p; - int nbytes; - if (p <= stop) - { - if (p <= endp) - break; - p = GPT_ADDR; - stop = endp; - } - prev_p = p; - while (--p >= stop && ! CHAR_HEAD_P (*p)); - PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes); - if (prev_p - p > nbytes) - p = prev_p - 1, c = *p, nbytes = 1; - else - c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH); - pos--, pos_byte -= nbytes; - UPDATE_SYNTAX_TABLE_BACKWARD (pos); - if (! fastmap[(int) SYNTAX (c)]) - { - pos++; - pos_byte += nbytes; + if (! fastmap[*p]) + break; + if (! ASCII_CHAR_P (c)) + { + /* As we are looking at a multibyte character, we + must look up the character in the table + CHAR_RANGES. If there's no data in the table, + that character is not what we want to skip. */ + + /* The following code do the right thing even if + n_char_ranges is zero (i.e. no data in + CHAR_RANGES). */ + for (i = 0; i < n_char_ranges; i += 2) + if (c >= char_ranges[i] && c <= char_ranges[i + 1]) break; - } + if (!(negate ^ (i < n_char_ranges))) + break; } - else - while (1) + fwd_ok: + p += nbytes, pos++, pos_byte += nbytes; + } + else + while (1) + { + if (p >= stop) { - if (p <= stop) - { - if (p <= endp) - break; - p = GPT_ADDR; - stop = endp; - } - UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); - if (! fastmap[(int) SYNTAX (p[-1])]) + if (p >= endp) break; - p--, pos--; + p = GAP_END_ADDR; + stop = endp; } - } + + if (!NILP (iso_classes) && in_classes (*p, iso_classes)) + { + if (negate) + break; + else + goto fwd_unibyte_ok; + } + + if (!fastmap[*p]) + break; + fwd_unibyte_ok: + p++, pos++, pos_byte++; + } } else { - if (forwardp) - { - if (multibyte) - while (1) - { - int nbytes; - - if (p >= stop) - { - if (p >= endp) - break; - p = GAP_END_ADDR; - stop = endp; - } - c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes); + if (multibyte) + while (1) + { + unsigned char *prev_p; - if (! NILP (iso_classes) && in_classes (c, iso_classes)) - { - if (negate) - break; - else - goto fwd_ok; - } + if (p <= stop) + { + if (p <= endp) + break; + p = GPT_ADDR; + stop = endp; + } + prev_p = p; + while (--p >= stop && ! CHAR_HEAD_P (*p)); + c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH); - if (SINGLE_BYTE_CHAR_P (c)) - { - if (!fastmap[c]) - break; - } + if (! NILP (iso_classes) && in_classes (c, iso_classes)) + { + if (negate) + break; else - { - /* If we are looking at a multibyte character, - we must look up the character in the table - CHAR_RANGES. If there's no data in the - table, that character is not what we want to - skip. */ - - /* The following code do the right thing even if - n_char_ranges is zero (i.e. no data in - CHAR_RANGES). */ - for (i = 0; i < n_char_ranges; i += 2) - if (c >= char_ranges[i] && c <= char_ranges[i + 1]) - break; - if (!(negate ^ (i < n_char_ranges))) - break; - } - fwd_ok: - p += nbytes, pos++, pos_byte += nbytes; + goto back_ok; } - else - while (1) - { - if (p >= stop) - { - if (p >= endp) - break; - p = GAP_END_ADDR; - stop = endp; - } - - if (!NILP (iso_classes) && in_classes (*p, iso_classes)) - { - if (negate) - break; - else - goto fwd_unibyte_ok; - } - if (!fastmap[*p]) + if (! fastmap[*p]) + break; + if (! ASCII_CHAR_P (c)) + { + /* See the comment in the previous similar code. */ + for (i = 0; i < n_char_ranges; i += 2) + if (c >= char_ranges[i] && c <= char_ranges[i + 1]) + break; + if (!(negate ^ (i < n_char_ranges))) break; - fwd_unibyte_ok: - p++, pos++; } - } + back_ok: + pos--, pos_byte -= prev_p - p; + } else - { - if (multibyte) - while (1) + while (1) + { + if (p <= stop) { - unsigned char *prev_p; - int nbytes; + if (p <= endp) + break; + p = GPT_ADDR; + stop = endp; + } - if (p <= stop) - { - if (p <= endp) - break; - p = GPT_ADDR; - stop = endp; - } - prev_p = p; - while (--p >= stop && ! CHAR_HEAD_P (*p)); - PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes); - if (prev_p - p > nbytes) - p = prev_p - 1, c = *p, nbytes = 1; + if (! NILP (iso_classes) && in_classes (p[-1], iso_classes)) + { + if (negate) + break; else - c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH); + goto back_unibyte_ok; + } - if (! NILP (iso_classes) && in_classes (c, iso_classes)) - { - if (negate) - break; - else - goto back_ok; - } + if (!fastmap[p[-1]]) + break; + back_unibyte_ok: + p--, pos--, pos_byte--; + } + } - if (SINGLE_BYTE_CHAR_P (c)) - { - if (!fastmap[c]) - break; - } - else - { - /* See the comment in the previous similar code. */ - for (i = 0; i < n_char_ranges; i += 2) - if (c >= char_ranges[i] && c <= char_ranges[i + 1]) - break; - if (!(negate ^ (i < n_char_ranges))) - break; - } - back_ok: - pos--, pos_byte -= nbytes; - } - else - while (1) - { - if (p <= stop) - { - if (p <= endp) - break; - p = GPT_ADDR; - stop = endp; - } + SET_PT_BOTH (pos, pos_byte); + immediate_quit = 0; - if (! NILP (iso_classes) && in_classes (p[-1], iso_classes)) - { - if (negate) - break; - else - goto back_unibyte_ok; - } + return make_number (PT - start_point); + } +} - if (!fastmap[p[-1]]) - break; - back_unibyte_ok: - p--, pos--; - } - } + +static Lisp_Object +skip_syntaxes (forwardp, string, lim) + int forwardp; + Lisp_Object string, lim; +{ + register unsigned int c; + unsigned char fastmap[0400]; + int negate = 0; + register int i, i_byte; + int multibyte; + int size_byte; + unsigned char *str; + + CHECK_STRING (string); + + if (NILP (lim)) + XSETINT (lim, forwardp ? ZV : BEGV); + else + CHECK_NUMBER_COERCE_MARKER (lim); + + /* In any case, don't allow scan outside bounds of buffer. */ + if (XINT (lim) > ZV) + XSETFASTINT (lim, ZV); + if (XINT (lim) < BEGV) + XSETFASTINT (lim, BEGV); + + if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim))) + return make_number (0); + + multibyte = (!NILP (current_buffer->enable_multibyte_characters) + && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); + + bzero (fastmap, sizeof fastmap); + + if (SBYTES (string) > SCHARS (string)) + /* As this is very rare case (syntax spec is ASCII only), don't + consider efficiency. */ + string = string_make_unibyte (string); + + str = SDATA (string); + size_byte = SBYTES (string); + + i_byte = 0; + if (i_byte < size_byte + && SREF (string, 0) == '^') + { + negate = 1; i_byte++; + } + + /* Find the syntaxes specified and set their elements of fastmap. */ + + while (i_byte < size_byte) + { + c = str[i_byte++]; + fastmap[syntax_spec_code[c]] = 1; + } + + /* If ^ was the first character, complement the fastmap. */ + if (negate) + for (i = 0; i < sizeof fastmap; i++) + fastmap[i] ^= 1; + + { + int start_point = PT; + int pos = PT; + int pos_byte = PT_BYTE; + unsigned char *p = PT_ADDR, *endp, *stop; + + if (forwardp) + { + endp = (XINT (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim)); + stop = (pos < GPT && GPT < XINT (lim)) ? GPT_ADDR : endp; + } + else + { + endp = CHAR_POS_ADDR (XINT (lim)); + stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp; } -#if 0 /* Not needed now that a position in mid-character - cannot be specified in Lisp. */ - if (multibyte - /* INC_POS or DEC_POS might have moved POS over LIM. */ - && (forwardp ? (pos > XINT (lim)) : (pos < XINT (lim)))) - pos = XINT (lim); -#endif + immediate_quit = 1; + SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1); + if (forwardp) + { + if (multibyte) + { + while (1) + { + int nbytes; + + if (p >= stop) + { + if (p >= endp) + break; + p = GAP_END_ADDR; + stop = endp; + } + c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes); + if (! fastmap[(int) SYNTAX (c)]) + break; + p += nbytes, pos++, pos_byte += nbytes; + UPDATE_SYNTAX_TABLE_FORWARD (pos); + } + } + else + { + while (1) + { + if (p >= stop) + { + if (p >= endp) + break; + p = GAP_END_ADDR; + stop = endp; + } + if (! fastmap[(int) SYNTAX (*p)]) + break; + p++, pos++, pos_byte++; + UPDATE_SYNTAX_TABLE_FORWARD (pos); + } + } + } + else + { + if (multibyte) + { + while (1) + { + unsigned char *prev_p; - if (! multibyte) - pos_byte = pos; + if (p <= stop) + { + if (p <= endp) + break; + p = GPT_ADDR; + stop = endp; + } + UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); + prev_p = p; + while (--p >= stop && ! CHAR_HEAD_P (*p)); + c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH); + if (! fastmap[(int) SYNTAX (c)]) + break; + pos--, pos_byte -= prev_p - p; + } + } + else + { + while (1) + { + if (p <= stop) + { + if (p <= endp) + break; + p = GPT_ADDR; + stop = endp; + } + UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1); + if (! fastmap[(int) SYNTAX (p[-1])]) + break; + p--, pos--, pos_byte--; + } + } + } SET_PT_BOTH (pos, pos_byte); immediate_quit = 0; @@ -1921,7 +2142,7 @@ forw_comment (from, from_byte, stop, nesting, style, prev_syntax, *bytepos_ptr = from_byte; return 0; } - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); syntax = SYNTAX_WITH_FLAGS (c); code = syntax & 0xff; if (code == Sendcomment @@ -1951,7 +2172,7 @@ forw_comment (from, from_byte, stop, nesting, style, prev_syntax, forw_incomment: if (from < stop && SYNTAX_FLAGS_COMEND_FIRST (syntax) && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style - && (c1 = FETCH_CHAR (from_byte), + && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), SYNTAX_COMEND_SECOND (c1)) && ((SYNTAX_FLAGS_COMMENT_NESTED (syntax) || SYNTAX_COMMENT_NESTED (c1)) ? nesting > 0 : nesting < 0)) @@ -1970,7 +2191,7 @@ forw_comment (from, from_byte, stop, nesting, style, prev_syntax, if (nesting > 0 && from < stop && SYNTAX_FLAGS_COMSTART_FIRST (syntax) - && (c1 = FETCH_CHAR (from_byte), + && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), SYNTAX_COMMENT_STYLE (c1) == style && SYNTAX_COMSTART_SECOND (c1)) && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) || @@ -2034,7 +2255,7 @@ between them, return t; otherwise return nil. */) immediate_quit = 0; return Qnil; } - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX (c); comstart_first = SYNTAX_COMSTART_FIRST (c); comnested = SYNTAX_COMMENT_NESTED (c); @@ -2042,7 +2263,7 @@ between them, return t; otherwise return nil. */) INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); if (from < stop && comstart_first - && (c1 = FETCH_CHAR (from_byte), + && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), SYNTAX_COMSTART_SECOND (c1))) { /* We have encountered a comment start sequence and we @@ -2100,7 +2321,7 @@ between them, return t; otherwise return nil. */) DEC_BOTH (from, from_byte); /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ quoted = char_quoted (from, from_byte); - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX (c); comstyle = 0; comnested = SYNTAX_COMMENT_NESTED (c); @@ -2117,7 +2338,7 @@ between them, return t; otherwise return nil. */) code = Sendcomment; /* Calling char_quoted, above, set up global syntax position at the new value of FROM. */ - c1 = FETCH_CHAR (from_byte); + c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); comstyle = SYNTAX_COMMENT_STYLE (c1); comnested = comnested || SYNTAX_COMMENT_NESTED (c1); } @@ -2131,7 +2352,7 @@ between them, return t; otherwise return nil. */) { DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); if (SYNTAX (c) == Scomment_fence && !char_quoted (from, from_byte)) { @@ -2197,11 +2418,11 @@ between them, return t; otherwise return nil. */) return Qt; } -/* Return syntax code of character C if C is a single byte character +/* Return syntax code of character C if C is an ASCII character or `multibyte_symbol_p' is zero. Otherwise, return Ssymbol. */ -#define SYNTAX_WITH_MULTIBYTE_CHECK(c) \ - ((SINGLE_BYTE_CHAR_P (c) || !multibyte_symbol_p) \ +#define SYNTAX_WITH_MULTIBYTE_CHECK(c) \ + ((ASCII_CHAR_P (c) || !multibyte_symbol_p) \ ? SYNTAX (c) : Ssymbol) static Lisp_Object @@ -2245,7 +2466,7 @@ scan_lists (from, count, depth, sexpflag) { int comstart_first, prefix; UPDATE_SYNTAX_TABLE_FORWARD (from); - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX_WITH_MULTIBYTE_CHECK (c); comstart_first = SYNTAX_COMSTART_FIRST (c); comnested = SYNTAX_COMMENT_NESTED (c); @@ -2256,7 +2477,8 @@ scan_lists (from, count, depth, sexpflag) INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); if (from < stop && comstart_first - && (c = FETCH_CHAR (from_byte), SYNTAX_COMSTART_SECOND (c)) + && (c = FETCH_CHAR_AS_MULTIBYTE (from_byte), + SYNTAX_COMSTART_SECOND (c)) && parse_sexp_ignore_comments) { /* we have encountered a comment start sequence and we @@ -2265,7 +2487,7 @@ scan_lists (from, count, depth, sexpflag) only a comment end of the same style actually ends the comment section */ code = Scomment; - c1 = FETCH_CHAR (from_byte); + c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); comstyle = SYNTAX_COMMENT_STYLE (c1); comnested = comnested || SYNTAX_COMMENT_NESTED (c1); INC_BOTH (from, from_byte); @@ -2291,7 +2513,7 @@ scan_lists (from, count, depth, sexpflag) UPDATE_SYNTAX_TABLE_FORWARD (from); /* Some compilers can't handle this inside the switch. */ - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); temp = SYNTAX_WITH_MULTIBYTE_CHECK (c); switch (temp) { @@ -2334,7 +2556,7 @@ scan_lists (from, count, depth, sexpflag) case Smath: if (!sexpflag) break; - if (from != stop && c == FETCH_CHAR (from_byte)) + if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (from_byte)) { INC_BOTH (from, from_byte); } @@ -2361,12 +2583,12 @@ scan_lists (from, count, depth, sexpflag) case Sstring: case Sstring_fence: temp_pos = dec_bytepos (from_byte); - stringterm = FETCH_CHAR (temp_pos); + stringterm = FETCH_CHAR_AS_MULTIBYTE (temp_pos); while (1) { if (from >= stop) goto lose; UPDATE_SYNTAX_TABLE_FORWARD (from); - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); if (code == Sstring ? (c == stringterm && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring) @@ -2409,7 +2631,7 @@ scan_lists (from, count, depth, sexpflag) { DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); code = SYNTAX_WITH_MULTIBYTE_CHECK (c); if (depth == min_depth) last_good = from; @@ -2427,7 +2649,7 @@ scan_lists (from, count, depth, sexpflag) DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); code = Sendcomment; - c1 = FETCH_CHAR (from_byte); + c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); comstyle = SYNTAX_COMMENT_STYLE (c1); comnested = comnested || SYNTAX_COMMENT_NESTED (c1); } @@ -2460,7 +2682,7 @@ scan_lists (from, count, depth, sexpflag) else temp_pos--; UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); - c1 = FETCH_CHAR (temp_pos); + c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos); temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1); /* Don't allow comment-end to be quoted. */ if (temp_code == Sendcomment) @@ -2472,7 +2694,7 @@ scan_lists (from, count, depth, sexpflag) temp_pos = dec_bytepos (temp_pos); UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); } - c1 = FETCH_CHAR (temp_pos); + c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos); temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1); if (! (quoted || temp_code == Sword || temp_code == Ssymbol @@ -2487,7 +2709,7 @@ scan_lists (from, count, depth, sexpflag) break; temp_pos = dec_bytepos (from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from - 1); - if (from != stop && c == FETCH_CHAR (temp_pos)) + if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (temp_pos)) DEC_BOTH (from, from_byte); if (mathexit) { @@ -2532,7 +2754,7 @@ scan_lists (from, count, depth, sexpflag) DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); if (!char_quoted (from, from_byte) - && (c = FETCH_CHAR (from_byte), + && (c = FETCH_CHAR_AS_MULTIBYTE (from_byte), SYNTAX_WITH_MULTIBYTE_CHECK (c) == code)) break; } @@ -2540,14 +2762,15 @@ scan_lists (from, count, depth, sexpflag) break; case Sstring: - stringterm = FETCH_CHAR (from_byte); + stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte); while (1) { if (from == stop) goto lose; DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); if (!char_quoted (from, from_byte) - && stringterm == (c = FETCH_CHAR (from_byte)) + && (stringterm + == (c = FETCH_CHAR_AS_MULTIBYTE (from_byte))) && SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring) break; } @@ -2650,7 +2873,7 @@ This includes chars with "quote" or "prefix" syntax (' or p). */) while (!char_quoted (pos, pos_byte) /* Previous statement updates syntax table. */ - && ((c = FETCH_CHAR (pos_byte), SYNTAX (c) == Squote) + && ((c = FETCH_CHAR_AS_MULTIBYTE (pos_byte), SYNTAX (c) == Squote) || SYNTAX_PREFIX (c))) { opoint = pos; @@ -2678,7 +2901,8 @@ scan_sexps_forward (stateptr, from, from_byte, end, targetdepth, stopbefore, oldstate, commentstop) struct lisp_parse_state *stateptr; register int from; - int end, targetdepth, stopbefore, from_byte; + int from_byte; + int end, targetdepth, stopbefore; Lisp_Object oldstate; int commentstop; { @@ -2715,7 +2939,7 @@ scan_sexps_forward (stateptr, from, from_byte, end, targetdepth, #define INC_FROM \ do { prev_from = from; \ prev_from_byte = from_byte; \ - temp = FETCH_CHAR (prev_from_byte); \ + temp = FETCH_CHAR_AS_MULTIBYTE (prev_from_byte); \ prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \ INC_BOTH (from, from_byte); \ if (from < end) \ @@ -2871,7 +3095,7 @@ do { prev_from = from; \ while (from < end) { /* Some compilers can't handle this inside the switch. */ - temp = FETCH_CHAR (from_byte); + temp = FETCH_CHAR_AS_MULTIBYTE (from_byte); temp = SYNTAX (temp); switch (temp) { @@ -2945,7 +3169,7 @@ do { prev_from = from; \ if (stopbefore) goto stop; /* this arg means stop at sexp start */ curlevel->last = prev_from; state.instring = (code == Sstring - ? (FETCH_CHAR (prev_from_byte)) + ? (FETCH_CHAR_AS_MULTIBYTE (prev_from_byte)) : ST_STRING_STYLE); if (boundary_stop) goto done; startinstring: @@ -2957,7 +3181,7 @@ do { prev_from = from; \ int c; if (from >= end) goto done; - c = FETCH_CHAR (from_byte); + c = FETCH_CHAR_AS_MULTIBYTE (from_byte); /* Some compilers can't handle this inside the switch. */ temp = SYNTAX (c); @@ -3183,8 +3407,7 @@ init_syntax_once () /* All multibyte characters have syntax `word' by default. */ temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword]; - for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++) - XCHAR_TABLE (Vstandard_syntax_table)->contents[i] = temp; + char_table_set_range (Vstandard_syntax_table, 0x80, MAX_CHAR, temp); } void @@ -3232,6 +3455,25 @@ See the info node `(elisp)Syntax Properties' for a description of the doc: /* *Non-nil means an open paren in column 0 denotes the start of a defun. */); open_paren_in_column_0_is_defun_start = 1; + + DEFVAR_LISP ("find-word-boundary-function-table", + &Vfind_word_boundary_function_table, + doc: /* +Char table of functions to search for the word boundary. +Each function is called with two arguments; POS and LIMIT. +POS and LIMIT are character positions in the current buffer. + +If POS is less than LIMIT, POS is at the first character of a word, +and the return value of a function is a position after the last +character of that word. + +If POS is not less than LIMIT, POS is at the last character of a word, +and the return value of a function is a position at the first +character of that word. + +In both cases, LIMIT bounds the search. */); + Vfind_word_boundary_function_table = Fmake_char_table (Qnil, Qnil); + defsubr (&Ssyntax_table_p); defsubr (&Ssyntax_table); defsubr (&Sstandard_syntax_table); diff --git a/src/syntax.h b/src/syntax.h index 4026eeaee8f..a23e838deae 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -58,37 +58,14 @@ enum syntaxcode /* Set the syntax entry VAL for char C in table TABLE. */ -#define SET_RAW_SYNTAX_ENTRY(table, c, val) \ - ((((c) & 0xFF) == (c)) \ - ? (XCHAR_TABLE (table)->contents[(unsigned char) (c)] = (val)) \ - : Faset ((table), make_number (c), (val))) +#define SET_RAW_SYNTAX_ENTRY(table, c, val) \ + CHAR_TABLE_SET ((table), c, (val)) -/* Fetch the syntax entry for char C in syntax table TABLE. - This macro is called only when C is less than CHAR_TABLE_ORDINARY_SLOTS. - Do inheritance. */ +/* Set the syntax entry VAL for char-range RANGE in table TABLE. + RANGE is a cons (FROM . TO) specifying the range of characters. */ -#ifdef __GNUC__ -#define SYNTAX_ENTRY_FOLLOW_PARENT(table, c) \ - ({ Lisp_Object _syntax_tbl = (table); \ - Lisp_Object _syntax_temp = XCHAR_TABLE (_syntax_tbl)->contents[(c)]; \ - while (NILP (_syntax_temp)) \ - { \ - _syntax_tbl = XCHAR_TABLE (_syntax_tbl)->parent; \ - if (NILP (_syntax_tbl)) \ - break; \ - _syntax_temp = XCHAR_TABLE (_syntax_tbl)->contents[(c)]; \ - } \ - _syntax_temp; }) -#else -extern Lisp_Object syntax_temp; -extern Lisp_Object syntax_parent_lookup P_ ((Lisp_Object, int)); - -#define SYNTAX_ENTRY_FOLLOW_PARENT(table, c) \ - (syntax_temp = XCHAR_TABLE (table)->contents[(c)], \ - (NILP (syntax_temp) \ - ? syntax_parent_lookup (table, (c)) \ - : syntax_temp)) -#endif +#define SET_RAW_SYNTAX_ENTRY_RANGE(table, range, val) \ + Fset_char_table_range ((table), (range), (val)) /* SYNTAX_ENTRY fetches the information from the entry for character C in syntax table TABLE, or from globally kept data (gl_state). @@ -106,12 +83,7 @@ extern Lisp_Object syntax_parent_lookup P_ ((Lisp_Object, int)); # define CURRENT_SYNTAX_TABLE current_buffer->syntax_table #endif -#define SYNTAX_ENTRY_INT(c) \ - ((((c) & 0xFF) == (c)) \ - ? SYNTAX_ENTRY_FOLLOW_PARENT (CURRENT_SYNTAX_TABLE, \ - (unsigned char) (c)) \ - : Faref (CURRENT_SYNTAX_TABLE, \ - make_number (c))) +#define SYNTAX_ENTRY_INT(c) CHAR_TABLE_REF (CURRENT_SYNTAX_TABLE, (c)) /* Extract the information from the entry for character C in the current syntax table. */ @@ -138,6 +110,7 @@ extern Lisp_Object syntax_parent_lookup P_ ((Lisp_Object, int)); ? XCDR (_syntax_temp) \ : Qnil); }) #else +extern Lisp_Object syntax_temp; #define SYNTAX(c) \ (syntax_temp = SYNTAX_ENTRY ((c)), \ (CONSP (syntax_temp) \ diff --git a/src/term.c b/src/term.c index 20c7be33e38..e7d66420ffa 100644 --- a/src/term.c +++ b/src/term.c @@ -42,8 +42,11 @@ Boston, MA 02110-1301, USA. */ #include "lisp.h" #include "termchar.h" #include "termopts.h" +#include "buffer.h" +#include "character.h" #include "charset.h" #include "coding.h" +#include "composite.h" #include "keyboard.h" #include "frame.h" #include "disptab.h" @@ -187,7 +190,6 @@ extern char *tgetstr (); #ifdef HAVE_GPM #include <sys/fcntl.h> -#include "buffer.h" static void term_clear_mouse_face (); static void term_mouse_highlight (struct frame *f, int x, int y); @@ -548,10 +550,12 @@ tty_clear_end_of_line (struct frame *f, int first_unused_hpos) } } -/* Buffer to store the source and result of code conversion for terminal. */ -static unsigned char *encode_terminal_buf; -/* Allocated size of the above buffer. */ -static int encode_terminal_bufsize; +/* Buffers to store the source and result of code conversion for terminal. */ +static unsigned char *encode_terminal_src; +static unsigned char *encode_terminal_dst; +/* Allocated sizes of the above buffers. */ +static int encode_terminal_src_size; +static int encode_terminal_dst_size; /* Encode SRC_LEN glyphs starting at SRC to terminal output codes. Set CODING->produced to the byte-length of the resulting byte @@ -569,37 +573,73 @@ encode_terminal_code (src, src_len, coding) int nchars, nbytes, required; register int tlen = GLYPH_TABLE_LENGTH; register Lisp_Object *tbase = GLYPH_TABLE_BASE; + Lisp_Object charset_list; /* Allocate sufficient size of buffer to store all characters in multibyte-form. But, it may be enlarged on demand if - Vglyph_table contains a string. */ + Vglyph_table contains a string or a composite glyph is + encountered. */ required = MAX_MULTIBYTE_LENGTH * src_len; - if (encode_terminal_bufsize < required) + if (encode_terminal_src_size < required) { - if (encode_terminal_bufsize == 0) - encode_terminal_buf = xmalloc (required); + if (encode_terminal_src_size == 0) + encode_terminal_src = xmalloc (required); else - encode_terminal_buf = xrealloc (encode_terminal_buf, required); - encode_terminal_bufsize = required; + encode_terminal_src = xrealloc (encode_terminal_src, required); + encode_terminal_src_size = required; } - buf = encode_terminal_buf; + charset_list = coding_charset_list (coding); + + buf = encode_terminal_src; nchars = 0; while (src < src_end) { + if (src->type == COMPOSITE_GLYPH) + { + struct composition *cmp = composition_table[src->u.cmp_id]; + int i; + + nbytes = buf - encode_terminal_src; + required = MAX_MULTIBYTE_LENGTH * cmp->glyph_len; + + if (encode_terminal_src_size < nbytes + required) + { + encode_terminal_src_size = nbytes + required; + encode_terminal_src = xrealloc (encode_terminal_src, + encode_terminal_src_size); + buf = encode_terminal_src + nbytes; + } + + for (i = 0; i < cmp->glyph_len; i++) + { + int c = COMPOSITION_GLYPH (cmp, i); + + if (! char_charset (c, charset_list, NULL)) + break; + buf += CHAR_STRING (c, buf); + nchars++; + } + if (i == 0) + { + /* The first character of the composition is not encodable. */ + *buf++ = '?'; + nchars++; + } + } /* We must skip glyphs to be padded for a wide character. */ - if (! CHAR_GLYPH_PADDING_P (*src)) + else if (! CHAR_GLYPH_PADDING_P (*src)) { + int c; + Lisp_Object string; + + string = Qnil; g = GLYPH_FROM_CHAR_GLYPH (src[0]); if (g < 0 || g >= tlen) { /* This glyph doesn't has an entry in Vglyph_table. */ - if (CHAR_VALID_P (src->u.ch, 0)) - buf += CHAR_STRING (src->u.ch, buf); - else - *buf++ = SPACEGLYPH; - nchars++; + c = src->u.ch; } else { @@ -608,65 +648,90 @@ encode_terminal_code (src, src_len, coding) GLYPH_FOLLOW_ALIASES (tbase, tlen, g); if (GLYPH_SIMPLE_P (tbase, tlen, g)) - { - int c = FAST_GLYPH_CHAR (g); + /* We set the multi-byte form of a character in G + (that should be an ASCII character) at WORKBUF. */ + c = FAST_GLYPH_CHAR (g); + else + /* We have a string in Vglyph_table. */ + string = tbase[g]; + } - if (CHAR_VALID_P (c, 0)) - buf += CHAR_STRING (c, buf); - else - *buf++ = SPACEGLYPH; + if (NILP (string)) + { + nbytes = buf - encode_terminal_src; + if (encode_terminal_src_size < nbytes + MAX_MULTIBYTE_LENGTH) + { + encode_terminal_src_size = nbytes + MAX_MULTIBYTE_LENGTH; + encode_terminal_src = xrealloc (encode_terminal_src, + encode_terminal_src_size); + buf = encode_terminal_src + nbytes; + } + if (char_charset (c, charset_list, NULL)) + { + /* Store the multibyte form of C at BUF. */ + buf += CHAR_STRING (c, buf); nchars++; } else { - /* We have a string in Vglyph_table. */ - Lisp_Object string; - - string = tbase[g]; - if (! STRING_MULTIBYTE (string)) - string = string_to_multibyte (string); - nbytes = buf - encode_terminal_buf; - if (encode_terminal_bufsize < nbytes + SBYTES (string)) + /* C is not encodable. */ + *buf++ = '?'; + nchars++; + while (src + 1 < src_end && CHAR_GLYPH_PADDING_P (src[1])) { - encode_terminal_bufsize = nbytes + SBYTES (string); - encode_terminal_buf = xrealloc (encode_terminal_buf, - encode_terminal_bufsize); - buf = encode_terminal_buf + nbytes; + *buf++ = '?'; + nchars++; + src++; } - bcopy (SDATA (string), buf, SBYTES (string)); - buf += SBYTES (string); - nchars += SCHARS (string); } } + else + { + unsigned char *p = SDATA (string), *pend = p + SBYTES (string); + + if (! STRING_MULTIBYTE (string)) + string = string_to_multibyte (string); + nbytes = buf - encode_terminal_src; + if (encode_terminal_src_size < nbytes + SBYTES (string)) + { + encode_terminal_src_size = nbytes + SBYTES (string); + encode_terminal_src = xrealloc (encode_terminal_src, + encode_terminal_src_size); + buf = encode_terminal_src + nbytes; + } + bcopy (SDATA (string), buf, SBYTES (string)); + buf += SBYTES (string); + nchars += SCHARS (string); + } } src++; } - nbytes = buf - encode_terminal_buf; - coding->src_multibyte = 1; - coding->dst_multibyte = 0; - if (SYMBOLP (coding->pre_write_conversion) - && ! NILP (Ffboundp (coding->pre_write_conversion))) + if (nchars == 0) { - run_pre_write_conversin_on_c_str (&encode_terminal_buf, - &encode_terminal_bufsize, - nchars, nbytes, coding); - nchars = coding->produced_char; - nbytes = coding->produced; + coding->produced = 0; + return NULL; } - required = nbytes + encoding_buffer_size (coding, nbytes); - if (encode_terminal_bufsize < required) + + nbytes = buf - encode_terminal_src; + coding->source = encode_terminal_src; + if (encode_terminal_dst_size == 0) { - encode_terminal_bufsize = required; - encode_terminal_buf = xrealloc (encode_terminal_buf, required); + encode_terminal_dst_size = encode_terminal_src_size; + encode_terminal_dst = xmalloc (encode_terminal_dst_size); } + coding->destination = encode_terminal_dst; + coding->dst_bytes = encode_terminal_dst_size; + encode_coding_object (coding, Qnil, 0, 0, nchars, nbytes, Qnil); + /* coding->destination may have been reallocated. */ + encode_terminal_dst = coding->destination; + encode_terminal_dst_size = coding->dst_bytes; - encode_coding (coding, encode_terminal_buf, encode_terminal_buf + nbytes, - nbytes, encode_terminal_bufsize - nbytes); - return encode_terminal_buf + nbytes; + return (encode_terminal_dst); } + /* An implementation of write_glyphs for termcap frames. */ static void @@ -1420,11 +1485,14 @@ term_get_fkeys_1 () #ifdef static #define append_glyph append_glyph_term #define produce_stretch_glyph produce_stretch_glyph_term +#define append_composite_glyph append_composite_glyph_term +#define produce_composite_glyph produce_composite_glyph_term #endif static void append_glyph P_ ((struct it *)); static void produce_stretch_glyph P_ ((struct it *)); - +static void append_composite_glyph P_ ((struct it *)); +static void produce_composite_glyph P_ ((struct it *)); /* Append glyphs to IT's glyph_row. Called from produce_glyphs for terminal frames if IT->glyph_row != NULL. IT->char_to_display is @@ -1485,6 +1553,8 @@ produce_glyphs (it) struct it *it; { /* If a hook is installed, let it do the work. */ + + /* Nothing but characters are supported on terminal frames. */ xassert (it->what == IT_CHARACTER || it->what == IT_COMPOSITION || it->what == IT_STRETCH); @@ -1495,11 +1565,11 @@ produce_glyphs (it) goto done; } - /* Nothing but characters are supported on terminal frames. For a - composition sequence, it->c is the first character of the - sequence. */ - xassert (it->what == IT_CHARACTER - || it->what == IT_COMPOSITION); + if (it->what == IT_COMPOSITION) + { + produce_composite_glyph (it); + goto done; + } /* Maybe translate single-byte characters to multibyte. */ it->char_to_display = it->c; @@ -1543,28 +1613,24 @@ produce_glyphs (it) it->pixel_width = nspaces; it->nglyphs = nspaces; } - else if (SINGLE_BYTE_CHAR_P (it->c)) + else if (CHAR_BYTE8_P (it->c)) { if (unibyte_display_via_language_environment - && (it->c >= 0240 - || !NILP (Vnonascii_translation_table))) + && (it->c >= 0240)) { - int charset; - it->char_to_display = unibyte_char_to_multibyte (it->c); - charset = CHAR_CHARSET (it->char_to_display); - it->pixel_width = CHARSET_WIDTH (charset); + it->pixel_width = CHAR_WIDTH (it->char_to_display); it->nglyphs = it->pixel_width; if (it->glyph_row) append_glyph (it); } else { - /* Coming here means that it->c is from display table, thus we - must send the code as is to the terminal. Although there's - no way to know how many columns it occupies on a screen, it - is a good assumption that a single byte code has 1-column - width. */ + /* Coming here means that it->c is from display table, thus + we must send the raw 8-bit byte as is to the terminal. + Although there's no way to know how many columns it + occupies on a screen, it is a good assumption that a + single byte code has 1-column width. */ it->pixel_width = it->nglyphs = 1; if (it->glyph_row) append_glyph (it); @@ -1572,13 +1638,7 @@ produce_glyphs (it) } else { - /* A multi-byte character. The display width is fixed for all - characters of the set. Some of the glyphs may have to be - ignored because they are already displayed in a continued - line. */ - int charset = CHAR_CHARSET (it->c); - - it->pixel_width = CHARSET_WIDTH (charset); + it->pixel_width = CHAR_WIDTH (it->c); it->nglyphs = it->pixel_width; if (it->glyph_row) @@ -1668,6 +1728,57 @@ produce_stretch_glyph (it) } +/* Append glyphs to IT's glyph_row for the composition IT->cmp_id. + Called from produce_composite_glyph for terminal frames if + IT->glyph_row != NULL. IT->face_id contains the character's + face. */ + +static void +append_composite_glyph (it) + struct it *it; +{ + struct glyph *glyph; + + xassert (it->glyph_row); + glyph = it->glyph_row->glyphs[it->area] + it->glyph_row->used[it->area]; + if (glyph < it->glyph_row->glyphs[1 + it->area]) + { + glyph->type = COMPOSITE_GLYPH; + glyph->pixel_width = it->pixel_width; + glyph->u.cmp_id = it->cmp_id; + glyph->face_id = it->face_id; + glyph->padding_p = 0; + glyph->charpos = CHARPOS (it->position); + glyph->object = it->object; + + ++it->glyph_row->used[it->area]; + ++glyph; + } +} + + +/* Produce a composite glyph for iterator IT. IT->cmp_id is the ID of + the composition. We simply produces components of the composition + assuming that that the terminal has a capability to layout/render + it correctly. */ + +static void +produce_composite_glyph (it) + struct it *it; +{ + struct composition *cmp = composition_table[it->cmp_id]; + int c; + + xassert (cmp->glyph_len > 0); + c = COMPOSITION_GLYPH (cmp, 0); + it->pixel_width = CHAR_WIDTH (it->c); + it->nglyphs = 1; + + if (it->glyph_row) + append_composite_glyph (it); +} + + /* Get information about special display element WHAT in an environment described by IT. WHAT is one of IT_TRUNCATION or IT_CONTINUATION. Maybe produce glyphs for WHAT if IT has a @@ -3269,7 +3380,8 @@ init_tty (char *name, char *terminal_type, int must_succeed) #endif - encode_terminal_bufsize = 0; + encode_terminal_src_size = 0; + encode_terminal_dst_size = 0; #ifdef HAVE_GPM terminal->mouse_position_hook = term_mouse_position; diff --git a/src/terminal.c b/src/terminal.c index 46ffb3c2dc8..8b1836b3681 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -242,8 +242,8 @@ create_terminal (void) terminal->terminal_coding = (struct coding_system *) xmalloc (sizeof (struct coding_system)); - setup_coding_system (Qnil, terminal->keyboard_coding); - setup_coding_system (Qnil, terminal->terminal_coding); + setup_coding_system (Qno_conversion, terminal->keyboard_coding); + setup_coding_system (Qundecided, terminal->terminal_coding); terminal->param_alist = Qnil; return terminal; diff --git a/src/w16select.c b/src/w16select.c index a66fba7d078..80246af8fbd 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -39,7 +39,7 @@ Boston, MA 02110-1301, USA. */ #include "frame.h" /* Need this to get the X window of selected_frame */ #include "blockinput.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "composite.h" diff --git a/src/w32bdf.c b/src/w32bdf.c index 4a12b1f0190..dd6abd8a743 100644 --- a/src/w32bdf.c +++ b/src/w32bdf.c @@ -29,7 +29,7 @@ Boston, MA 02110-1301, USA. */ #endif #include "lisp.h" -#include "charset.h" +#include "character.h" #include "keyboard.h" #include "frame.h" #include "dispextern.h" @@ -93,7 +93,7 @@ proceed_file_line(char *key, char *start, int *len, char **val, char **next) return 1; } -char* +static char* get_quoted_string(char *start, char *end) { char *p, *q, *result; @@ -202,7 +202,7 @@ set_bdf_font_info(bdffont *fontp) else if (search_file_line("CHARSET_ENCODING", start, len, (char **)&p, (char **)&q) == 1) { - fontp->encoding = get_quoted_string(p, q); + fontp->encoding = get_quoted_string(p, q); } else if (search_file_line("SLANT", start, len, (char **)&p, (char **)&q) == 1) @@ -790,7 +790,7 @@ struct font_info *w32_load_bdf_font (struct frame *f, char *fontname, uses this font. So, we set informatoin in fontp->encoding[1] which is never used by any charset. If mapping can't be decided, set FONT_ENCODING_NOT_DECIDED. */ - fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED; + fontp->encoding_type = FONT_ENCODING_NOT_DECIDED; fontp->baseline_offset = bdf_font->yoffset; fontp->relative_compose = bdf_font->relative_compose; fontp->default_ascent = bdf_font->default_ascent; diff --git a/src/w32console.c b/src/w32console.c index b1514f960b7..d5f7a66a0e8 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -32,7 +32,7 @@ Boston, MA 02110-1301, USA. #include <string.h> #include "lisp.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "disptab.h" #include "frame.h" diff --git a/src/w32fns.c b/src/w32fns.c index 497010e9ad3..8b2b865c6d3 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -30,22 +30,23 @@ Boston, MA 02110-1301, USA. */ #include <math.h> #include "lisp.h" -#include "charset.h" -#include "dispextern.h" #include "w32term.h" -#include "keyboard.h" #include "frame.h" #include "window.h" #include "buffer.h" -#include "fontset.h" #include "intervals.h" +#include "dispextern.h" +#include "keyboard.h" #include "blockinput.h" #include "epaths.h" -#include "w32heap.h" -#include "termhooks.h" +#include "character.h" +#include "charset.h" #include "coding.h" #include "ccl.h" +#include "fontset.h" #include "systime.h" +#include "termhooks.h" +#include "w32heap.h" #include "bitmaps/gray.xbm" @@ -57,8 +58,13 @@ Boston, MA 02110-1301, USA. */ #include <objbase.h> #include <dlgs.h> +#include <imm.h> #define FILE_NAME_TEXT_FIELD edt1 +#ifdef USE_FONT_BACKEND +#include "font.h" +#endif + void syms_of_w32fns (); void globals_of_w32fns (); @@ -256,11 +262,20 @@ static HWND track_mouse_window; typedef BOOL (WINAPI * TrackMouseEvent_Proc) (IN OUT LPTRACKMOUSEEVENT lpEventTrack); +typedef LONG (WINAPI * ImmGetCompositionString_Proc) + (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen); +typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window); TrackMouseEvent_Proc track_mouse_event_fn = NULL; ClipboardSequence_Proc clipboard_sequence_fn = NULL; +ImmGetCompositionString_Proc get_composition_string_fn = NULL; +ImmGetContext_Proc get_ime_context_fn = NULL; + extern AppendMenuW_Proc unicode_append_menu; +/* Flag to selectively ignore WM_IME_CHAR messages. */ +static int ignore_ime_char = 0; + /* W95 mousewheel handler */ unsigned int msh_mousewheel = 0; @@ -379,10 +394,10 @@ x_window_to_frame (dpyinfo, wdesc) Lisp_Object tail, frame; struct frame *f; - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { frame = XCAR (tail); - if (!GC_FRAMEP (frame)) + if (!FRAMEP (frame)) continue; f = XFRAME (frame); if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo) @@ -2449,8 +2464,8 @@ register_hot_keys (hwnd) { Lisp_Object keylist; - /* Use GC_CONSP, since we are called asynchronously. */ - for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist)) + /* Use CONSP, since we are called asynchronously. */ + for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist)) { Lisp_Object key = XCAR (keylist); @@ -2469,8 +2484,7 @@ unregister_hot_keys (hwnd) { Lisp_Object keylist; - /* Use GC_CONSP, since we are called asynchronously. */ - for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist)) + for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist)) { Lisp_Object key = XCAR (keylist); @@ -3150,7 +3164,6 @@ w32_wnd_proc (hwnd, msg, wParam, lParam) if (windows_translate) { MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} }; - windows_msg.time = GetMessageTime (); TranslateMessage (&windows_msg); goto dflt; @@ -3164,6 +3177,64 @@ w32_wnd_proc (hwnd, msg, wParam, lParam) w32_get_key_modifiers (wParam, lParam)); break; + case WM_UNICHAR: + /* WM_UNICHAR looks promising from the docs, but the exact + circumstances in which TranslateMessage sends it is one of those + Microsoft secret API things that EU and US courts are supposed + to have put a stop to already. Spy++ shows it being sent to Notepad + and other MS apps, but never to Emacs. + + Some third party IMEs send it in accordance with the official + documentation though, so handle it here. + + UNICODE_NOCHAR is used to test for support for this message. + TRUE indicates that the message is supported. */ + if (wParam == UNICODE_NOCHAR) + return TRUE; + + { + W32Msg wmsg; + wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam); + signal_user_input (); + my_post_msg (&wmsg, hwnd, msg, wParam, lParam); + } + break; + + case WM_IME_CHAR: + /* If we can't get the IME result as unicode, use default processing, + which will at least allow characters decodable in the system locale + get through. */ + if (!get_composition_string_fn) + goto dflt; + + else if (!ignore_ime_char) + { + wchar_t * buffer; + int size, i; + W32Msg wmsg; + HIMC context = get_ime_context_fn (hwnd); + wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam); + /* Get buffer size. */ + size = get_composition_string_fn (context, GCS_RESULTSTR, buffer, 0); + buffer = alloca(size); + size = get_composition_string_fn (context, GCS_RESULTSTR, + buffer, size); + signal_user_input (); + for (i = 0; i < size / sizeof (wchar_t); i++) + { + my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i], + lParam); + } + /* We output the whole string above, so ignore following ones + until we are notified of the end of composition. */ + ignore_ime_char = 1; + } + break; + + case WM_IME_ENDCOMPOSITION: + ignore_ime_char = 0; + goto dflt; + /* Simulate middle mouse button events when left and right buttons are used together, but only if user has two button mouse. */ case WM_LBUTTONDOWN: @@ -4136,6 +4207,38 @@ unwind_create_frame (frame) return Qnil; } +#ifdef USE_FONT_BACKEND +static void +x_default_font_parameter (f, parms) + struct frame *f; + Lisp_Object parms; +{ + struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f); + Lisp_Object font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", + RES_TYPE_STRING); + + if (!STRINGP (font)) + { + int i; + static char *names[] + = { "Courier New-10", + "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1", + "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1", + "Fixedsys", + NULL }; + + for (i = 0; names[i]; i++) + { + font = font_open_by_name (f, names[i]); + if (! NILP (font)) + break; + } + if (NILP (font)) + error ("No suitable font was found"); + } + x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING); +} +#endif DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, @@ -4271,8 +4374,28 @@ This function is an internal primitive--use `make-frame' instead. */) specbind (Qx_resource_name, name); } + f->resx = dpyinfo->resx; + f->resy = dpyinfo->resy; + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + /* Perhaps, we must allow frame parameter, say `font-backend', + to specify which font backends to use. */ + register_font_driver (&w32font_driver, f); + + x_default_parameter (f, parameters, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + } +#endif /* USE_FONT_BACKEND */ + /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + x_default_font_parameter (f, parameters); + else +#endif { Lisp_Object font; @@ -4284,7 +4407,7 @@ This function is an internal primitive--use `make-frame' instead. */) { tem = Fquery_fontset (font, Qnil); if (STRINGP (tem)) - font = x_new_fontset (f, SDATA (tem)); + font = x_new_fontset (f, tem); else font = x_new_font (f, SDATA (font)); } @@ -4679,10 +4802,10 @@ w32_load_system_font (f, fontname, size) fontp->name = (char *) xmalloc (strlen (fontname) + 1); bcopy (fontname, fontp->name, strlen (fontname) + 1); - if (lf.lfPitchAndFamily == FIXED_PITCH) + if ((lf.lfPitchAndFamily & 0x03) == FIXED_PITCH) { /* Fixed width font. */ - fontp->average_width = fontp->space_width = FONT_WIDTH (font); + fontp->average_width = fontp->space_width = FONT_AVG_WIDTH (font); } else { @@ -4692,11 +4815,12 @@ w32_load_system_font (f, fontname, size) if (pcm) fontp->space_width = pcm->width; else - fontp->space_width = FONT_WIDTH (font); + fontp->space_width = FONT_AVG_WIDTH (font); fontp->average_width = font->tm.tmAveCharWidth; } + fontp->charset = -1; charset = xlfd_charset_of_font (fontname); /* Cache the W32 codepage for a font. This makes w32_encode_char @@ -4723,7 +4847,7 @@ w32_load_system_font (f, fontname, size) (0:0x20..0x7F, 1:0xA0..0xFF, (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, 2:0xA020..0xFF7F). For the moment, we don't know which charset - uses this font. So, we set information in fontp->encoding[1] + uses this font. So, we set information in fontp->encoding_type which is never used by any charset. If mapping can't be decided, set FONT_ENCODING_NOT_DECIDED. */ @@ -4731,9 +4855,9 @@ w32_load_system_font (f, fontname, size) type FONT_ENCODING_NOT_DECIDED. */ encoding = strrchr (fontp->name, '-'); if (encoding && strnicmp (encoding+1, "sjis", 4) == 0) - fontp->encoding[1] = 4; + fontp->encoding_type = 4; else - fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED; + fontp->encoding_type = FONT_ENCODING_NOT_DECIDED; /* The following three values are set to 0 under W32, which is what they get set to if XGetFontProperty fails under X. */ @@ -4875,7 +4999,7 @@ w32_to_x_weight (fnweight) return "*"; } -static LONG +LONG x_to_w32_charset (lpcs) char * lpcs; { @@ -4887,12 +5011,16 @@ x_to_w32_charset (lpcs) if (strncmp (lpcs, "*-#", 3) == 0) return atoi (lpcs + 3); + /* All Windows fonts qualify as unicode. */ + if (!strncmp (lpcs, "iso10646", 8)) + return DEFAULT_CHARSET; + /* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */ charset = alloca (len + 1); strcpy (charset, lpcs); lpcs = strchr (charset, '*'); if (lpcs) - *lpcs = 0; + *lpcs = '\0'; /* Look through w32-charset-info-alist for the character set. Format of each entry is @@ -4959,12 +5087,27 @@ x_to_w32_charset (lpcs) } -static char * -w32_to_x_charset (fncharset) +char * +w32_to_x_charset (fncharset, matching) int fncharset; + char *matching; { static char buf[32]; Lisp_Object charset_type; + int match_len = 0; + + if (matching) + { + /* If fully specified, accept it as it is. Otherwise use a + substring match. */ + char *wildcard = strchr (matching, '*'); + if (wildcard) + *wildcard = '\0'; + else if (strchr (matching, '-')) + return matching; + + match_len = strlen (matching); + } switch (fncharset) { @@ -5049,6 +5192,7 @@ w32_to_x_charset (fncharset) { Lisp_Object rest; char * best_match = NULL; + int matching_found = 0; /* Look through w32-charset-info-alist for the character set. Prefer ISO codepages, and prefer lower numbers in the ISO @@ -5084,12 +5228,34 @@ w32_to_x_charset (fncharset) /* If we don't have a match already, then this is the best. */ if (!best_match) - best_match = x_charset; - /* If this is an ISO codepage, and the best so far isn't, - then this is better. */ - else if (strnicmp (best_match, "iso", 3) != 0 - && strnicmp (x_charset, "iso", 3) == 0) - best_match = x_charset; + { + best_match = x_charset; + if (matching && !strnicmp (x_charset, matching, match_len)) + matching_found = 1; + } + /* If we already found a match for MATCHING, then + only consider other matches. */ + else if (matching_found + && strnicmp (x_charset, matching, match_len)) + continue; + /* If this matches what we want, and the best so far doesn't, + then this is better. */ + else if (!matching_found && matching + && !strnicmp (x_charset, matching, match_len)) + { + best_match = x_charset; + matching_found = 1; + } + /* If this is fully specified, and the best so far isn't, + then this is better. */ + else if ((!strchr (best_match, '-') && strchr (x_charset, '-')) + /* If this is an ISO codepage, and the best so far isn't, + then this is better, but only if it fully specifies the + encoding. */ + || (strnicmp (best_match, "iso", 3) != 0 + && strnicmp (x_charset, "iso", 3) == 0 + && strchr (x_charset, '-'))) + best_match = x_charset; /* If both are ISO8859 codepages, choose the one with the lowest number in the encoding field. */ else if (strnicmp (best_match, "iso8859-", 8) == 0 @@ -5111,6 +5277,17 @@ w32_to_x_charset (fncharset) } strncpy (buf, best_match, 31); + /* If the charset is not fully specified, put -0 on the end. */ + if (!strchr (best_match, '-')) + { + int pos = strlen (best_match); + /* Charset specifiers shouldn't be very long. If it is a made + up one, truncating it should not do any harm since it isn't + recognized anyway. */ + if (pos > 29) + pos = 29; + strcpy (buf + pos, "-0"); + } buf[31] = '\0'; return buf; } @@ -5210,7 +5387,8 @@ w32_to_all_x_charsets (fncharset) { Lisp_Object rest; /* Look through w32-charset-info-alist for the character set. - Only return charsets for codepages which are installed. + Only return fully specified charsets for codepages which are + installed. Format of each entry in Vw32_charset_info_alist is (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)). @@ -5233,6 +5411,9 @@ w32_to_all_x_charsets (fncharset) w32_charset = XCAR (XCDR (this_entry)); codepage = XCDR (XCDR (this_entry)); + if (!strchr (SDATA (x_charset), '-')) + continue; + /* Look for Same charset and a valid codepage (or non-int which means ignore). */ if (EQ (w32_charset, charset_type) @@ -5263,9 +5444,6 @@ w32_codepage_for_font (char *fontname) Lisp_Object codepage, entry; char *charset_str, *charset, *end; - if (NILP (Vw32_charset_info_alist)) - return CP_DEFAULT; - /* Extract charset part of font string. */ charset = xlfd_charset_of_font (fontname); @@ -5291,7 +5469,13 @@ w32_codepage_for_font (char *fontname) *end = '\0'; } - entry = Fassoc (build_string (charset), Vw32_charset_info_alist); + if (!strcmp (charset, "iso10646")) + return CP_UNICODE; + + if (NILP (Vw32_charset_info_alist)) + return CP_DEFAULT; + + entry = Fassoc (build_string(charset), Vw32_charset_info_alist); if (NILP (entry)) return CP_UNKNOWN; @@ -5323,7 +5507,6 @@ w32_to_x_font (lplogfont, lpxstr, len, specific_charset) char *fontname_dash; int display_resy = (int) one_w32_display_info.resy; int display_resx = (int) one_w32_display_info.resx; - int bufsz; struct coding_system coding; if (!lpxstr) abort (); @@ -5345,12 +5528,14 @@ w32_to_x_font (lplogfont, lpxstr, len, specific_charset) coding.mode |= CODING_MODE_LAST_BLOCK; /* We explicitely disable composition handling because selection data should not contain any composition sequence. */ - coding.composing = COMPOSITION_DISABLED; - bufsz = decoding_buffer_size (&coding, LF_FACESIZE); + coding.common_flags &= ~CODING_ANNOTATION_MASK; + + coding.dst_bytes = LF_FACESIZE * 2; + coding.destination = (unsigned char *) xmalloc (coding.dst_bytes + 1); + decode_coding_c_string (&coding, lplogfont->lfFaceName, + strlen(lplogfont->lfFaceName), Qnil); + fontname = coding.destination; - fontname = alloca (sizeof (*fontname) * bufsz); - decode_coding (&coding, lplogfont->lfFaceName, fontname, - strlen (lplogfont->lfFaceName), bufsz - 1); *(fontname + coding.produced) = '\0'; /* Replace dashes with underscores so the dashes are not @@ -5394,8 +5579,7 @@ w32_to_x_font (lplogfont, lpxstr, len, specific_charset) ((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH) ? 'p' : 'c', /* spacing */ width_pixels, /* avg width */ - specific_charset ? specific_charset - : w32_to_x_charset (lplogfont->lfCharSet) + w32_to_x_charset (lplogfont->lfCharSet, specific_charset) /* charset registry and encoding */ ); @@ -5473,26 +5657,24 @@ x_to_w32_font (lpxstr, lplogfont) if (fields > 0 && name[0] != '*') { - int bufsize; - unsigned char *buf; - + Lisp_Object string = build_string (name); setup_coding_system (Fcheck_coding_system (Vlocale_coding_system), &coding); - coding.src_multibyte = 1; - coding.dst_multibyte = 0; - /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in - encode_coding_iso2022 trying to dereference a null pointer. */ - coding.composing = COMPOSITION_DISABLED; - if (coding.type == coding_type_iso2022) - coding.flags |= CODING_FLAG_ISO_SAFE; - bufsize = encoding_buffer_size (&coding, strlen (name)); - buf = (unsigned char *) alloca (bufsize); - coding.mode |= CODING_MODE_LAST_BLOCK; - encode_coding (&coding, name, buf, strlen (name), bufsize); + coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK); + /* Disable composition/charset annotation. */ + coding.common_flags &= ~CODING_ANNOTATION_MASK; + coding.dst_bytes = SCHARS (string) * 2; + + coding.destination = (unsigned char *) xmalloc (coding.dst_bytes); + encode_coding_object (&coding, string, 0, 0, + SCHARS (string), SBYTES (string), Qnil); if (coding.produced >= LF_FACESIZE) coding.produced = LF_FACESIZE - 1; - buf[coding.produced] = 0; - strcpy (lplogfont->lfFaceName, buf); + + coding.destination[coding.produced] = '\0'; + + strcpy (lplogfont->lfFaceName, coding.destination); + xfree (coding.destination); } else { @@ -5524,8 +5706,12 @@ x_to_w32_font (lpxstr, lplogfont) lplogfont->lfHeight = atoi (height) * dpi / 720; if (fields > 0) - lplogfont->lfPitchAndFamily = - (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH; + { + if (pitch == 'p') + lplogfont->lfPitchAndFamily = VARIABLE_PITCH | FF_DONTCARE; + else if (pitch == 'c') + lplogfont->lfPitchAndFamily = FIXED_PITCH | FF_DONTCARE; + } fields--; @@ -5870,14 +6056,17 @@ enum_font_cb2 (lplf, lptm, FontType, lpef) if (charset && strncmp (charset, "*-*", 3) != 0 && lpef->logfont.lfCharSet == DEFAULT_CHARSET - && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET)) != 0) + && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET, NULL)) != 0) return 1; } if (charset) charset_list = Fcons (build_string (charset), Qnil); else - charset_list = w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet); + /* Always prefer unicode. */ + charset_list + = Fcons (build_string ("iso10646-1"), + w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet)); /* Loop through the charsets. */ for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list)) @@ -5885,14 +6074,15 @@ enum_font_cb2 (lplf, lptm, FontType, lpef) Lisp_Object this_charset = Fcar (charset_list); charset = SDATA (this_charset); + enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont), + charset, width); + /* List bold and italic variations if w32-enable-synthesized-fonts is non-nil and this is a plain font. */ if (w32_enable_synthesized_fonts && lplf->elfLogFont.lfWeight == FW_NORMAL && lplf->elfLogFont.lfItalic == FALSE) { - enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont), - charset, width); /* bold. */ lplf->elfLogFont.lfWeight = FW_BOLD; enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont), @@ -5906,9 +6096,6 @@ enum_font_cb2 (lplf, lptm, FontType, lpef) enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont), charset, width); } - else - enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont), - charset, width); } } @@ -6173,7 +6360,7 @@ w32_list_fonts (f, pattern, size, maxnames) hdc = GetDC (dpyinfo->root_window); oldobj = SelectObject (hdc, thisinfo.hfont); if (GetTextMetrics (hdc, &thisinfo.tm)) - XSETCDR (tem, make_number (FONT_WIDTH (&thisinfo))); + XSETCDR (tem, make_number (FONT_AVG_WIDTH (&thisinfo))); else XSETCDR (tem, make_number (0)); SelectObject (hdc, oldobj); @@ -7308,8 +7495,28 @@ x_create_tip_frame (dpyinfo, parms, text) specbind (Qx_resource_name, name); } + f->resx = dpyinfo->resx; + f->resy = dpyinfo->resy; + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + /* Perhaps, we must allow frame parameter, say `font-backend', + to specify which font backends to use. */ + register_font_driver (&w32font_driver, f); + + x_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + } +#endif /* USE_FONT_BACKEND */ + /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + x_default_font_parameter (f, parms); + else +#endif /* USE_FONT_BACKEND */ { Lisp_Object font; @@ -7321,7 +7528,7 @@ x_create_tip_frame (dpyinfo, parms, text) { tem = Fquery_fontset (font, Qnil); if (STRINGP (tem)) - font = x_new_fontset (f, SDATA (tem)); + font = x_new_fontset (f, tem); else font = x_new_font (f, SDATA (font)); } @@ -8623,6 +8830,9 @@ frame_parm_handler w32_frame_parm_handlers[] = x_set_fringe_width, 0, /* x_set_wait_for_wm, */ x_set_fullscreen, +#ifdef USE_FONT_BACKEND + x_set_font_backend +#endif }; void @@ -8635,29 +8845,17 @@ syms_of_w32fns () w32_visible_system_caret_hwnd = NULL; - Qnone = intern ("none"); - staticpro (&Qnone); - Qsuppress_icon = intern ("suppress-icon"); - staticpro (&Qsuppress_icon); - Qundefined_color = intern ("undefined-color"); - staticpro (&Qundefined_color); - Qcancel_timer = intern ("cancel-timer"); - staticpro (&Qcancel_timer); - - Qhyper = intern ("hyper"); - staticpro (&Qhyper); - Qsuper = intern ("super"); - staticpro (&Qsuper); - Qmeta = intern ("meta"); - staticpro (&Qmeta); - Qalt = intern ("alt"); - staticpro (&Qalt); - Qctrl = intern ("ctrl"); - staticpro (&Qctrl); - Qcontrol = intern ("control"); - staticpro (&Qcontrol); - Qshift = intern ("shift"); - staticpro (&Qshift); + DEFSYM (Qnone, "none"); + DEFSYM (Qsuppress_icon, "suppress-icon"); + DEFSYM (Qundefined_color, "undefined-color"); + DEFSYM (Qcancel_timer, "cancel-timer"); + DEFSYM (Qhyper, "hyper"); + DEFSYM (Qsuper, "super"); + DEFSYM (Qmeta, "meta"); + DEFSYM (Qalt, "alt"); + DEFSYM (Qctrl, "ctrl"); + DEFSYM (Qcontrol, "control"); + DEFSYM (Qshift, "shift"); /* This is the end of symbol initialization. */ /* Text property `display' should be nonsticky by default. */ @@ -8947,24 +9145,16 @@ CODEPAGE should be an integer specifying the codepage that should be used to display the character set, t to do no translation and output as Unicode, or nil to do no translation and output as 8 bit (or multibyte on far-east versions of Windows) characters. */); - Vw32_charset_info_alist = Qnil; - - staticpro (&Qw32_charset_ansi); - Qw32_charset_ansi = intern ("w32-charset-ansi"); - staticpro (&Qw32_charset_symbol); - Qw32_charset_default = intern ("w32-charset-default"); - staticpro (&Qw32_charset_default); - Qw32_charset_symbol = intern ("w32-charset-symbol"); - staticpro (&Qw32_charset_shiftjis); - Qw32_charset_shiftjis = intern ("w32-charset-shiftjis"); - staticpro (&Qw32_charset_hangeul); - Qw32_charset_hangeul = intern ("w32-charset-hangeul"); - staticpro (&Qw32_charset_chinesebig5); - Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5"); - staticpro (&Qw32_charset_gb2312); - Qw32_charset_gb2312 = intern ("w32-charset-gb2312"); - staticpro (&Qw32_charset_oem); - Qw32_charset_oem = intern ("w32-charset-oem"); + Vw32_charset_info_alist = Qnil; + + DEFSYM (Qw32_charset_ansi, "w32-charset-ansi"); + DEFSYM (Qw32_charset_symbol, "w32-charset-symbol"); + DEFSYM (Qw32_charset_default, "w32-charset-default"); + DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis"); + DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul"); + DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5"); + DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312"); + DEFSYM (Qw32_charset_oem, "w32-charset-oem"); #ifdef JOHAB_CHARSET { @@ -8972,28 +9162,17 @@ versions of Windows) characters. */); DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined, doc: /* Internal variable. */); - staticpro (&Qw32_charset_johab); - Qw32_charset_johab = intern ("w32-charset-johab"); - staticpro (&Qw32_charset_easteurope); - Qw32_charset_easteurope = intern ("w32-charset-easteurope"); - staticpro (&Qw32_charset_turkish); - Qw32_charset_turkish = intern ("w32-charset-turkish"); - staticpro (&Qw32_charset_baltic); - Qw32_charset_baltic = intern ("w32-charset-baltic"); - staticpro (&Qw32_charset_russian); - Qw32_charset_russian = intern ("w32-charset-russian"); - staticpro (&Qw32_charset_arabic); - Qw32_charset_arabic = intern ("w32-charset-arabic"); - staticpro (&Qw32_charset_greek); - Qw32_charset_greek = intern ("w32-charset-greek"); - staticpro (&Qw32_charset_hebrew); - Qw32_charset_hebrew = intern ("w32-charset-hebrew"); - staticpro (&Qw32_charset_vietnamese); - Qw32_charset_vietnamese = intern ("w32-charset-vietnamese"); - staticpro (&Qw32_charset_thai); - Qw32_charset_thai = intern ("w32-charset-thai"); - staticpro (&Qw32_charset_mac); - Qw32_charset_mac = intern ("w32-charset-mac"); + DEFSYM (Qw32_charset_johab, "w32-charset-johab"); + DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope"); + DEFSYM (Qw32_charset_turkish, "w32-charset-turkish"); + DEFSYM (Qw32_charset_baltic, "w32-charset-baltic"); + DEFSYM (Qw32_charset_russian, "w32-charset-russian"); + DEFSYM (Qw32_charset_arabic, "w32-charset-arabic"); + DEFSYM (Qw32_charset_greek, "w32-charset-greek"); + DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew"); + DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese"); + DEFSYM (Qw32_charset_thai, "w32-charset-thai"); + DEFSYM (Qw32_charset_mac, "w32-charset-mac"); } #endif @@ -9003,9 +9182,7 @@ versions of Windows) characters. */); DEFVAR_BOOL ("w32-unicode-charset-defined", &w32_unicode_charset_defined, doc: /* Internal variable. */); - - staticpro (&Qw32_charset_unicode); - Qw32_charset_unicode = intern ("w32-charset-unicode"); + DEFSYM (Qw32_charset_unicode, "w32-charset-unicode"); } #endif @@ -9069,6 +9246,7 @@ versions of Windows) characters. */); find_ccl_program_func = w32_find_ccl_program; query_font_func = w32_query_font; set_frame_fontset_func = x_set_font; + get_font_repertory_func = x_get_font_repertory; check_window_system_func = check_w32; @@ -9109,7 +9287,13 @@ globals_of_w32fns () /* ditto for GetClipboardSequenceNumber. */ clipboard_sequence_fn = (ClipboardSequence_Proc) GetProcAddress (user32_lib, "GetClipboardSequenceNumber"); - + { + HMODULE imm32_lib = GetModuleHandle ("imm32.dll"); + get_composition_string_fn = (ImmGetCompositionString_Proc) + GetProcAddress (imm32_lib, "ImmGetCompositionStringW"); + get_ime_context_fn = (ImmGetContext_Proc) + GetProcAddress (imm32_lib, "ImmGetContext"); + } DEFVAR_INT ("w32-ansi-code-page", &w32_ansi_code_page, doc: /* The ANSI code page used by the system. */); diff --git a/src/w32font.c b/src/w32font.c new file mode 100644 index 00000000000..d8ef31ad2cb --- /dev/null +++ b/src/w32font.c @@ -0,0 +1,1531 @@ +/* Font backend for the Microsoft W32 API. + Copyright (C) 2007 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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <windows.h> + +#include "lisp.h" +#include "w32term.h" +#include "frame.h" +#include "dispextern.h" +#include "character.h" +#include "charset.h" +#include "fontset.h" +#include "font.h" +#include "w32font.h" + +/* Cleartype available on Windows XP, cleartype_natural from XP SP1. + The latter does not try to fit cleartype smoothed fonts into the + same bounding box as the non-antialiased version of the font. + */ +#ifndef CLEARTYPE_QUALITY +#define CLEARTYPE_QUALITY 5 +#endif +#ifndef CLEARTYPE_NATURAL_QUALITY +#define CLEARTYPE_NATURAL_QUALITY 6 +#endif + +extern struct font_driver w32font_driver; + +Lisp_Object Qgdi; +static Lisp_Object Qmonospace, Qsansserif, Qmono, Qsans, Qsans_serif; +static Lisp_Object Qserif, Qscript, Qdecorative; +static Lisp_Object Qraster, Qoutline, Qunknown; + +/* antialiasing */ +extern Lisp_Object QCantialias; /* defined in font.c */ +extern Lisp_Object Qnone; /* reuse from w32fns.c */ +static Lisp_Object Qstandard, Qsubpixel, Qnatural; + +/* scripts */ +static Lisp_Object Qlatin, Qgreek, Qcoptic, Qcyrillic, Qarmenian, Qhebrew; +static Lisp_Object Qarabic, Qsyriac, Qnko, Qthaana, Qdevanagari, Qbengali; +static Lisp_Object Qgurmukhi, Qgujarati, Qoriya, Qtamil, Qtelugu; +static Lisp_Object Qkannada, Qmalayalam, Qsinhala, Qthai, Qlao; +static Lisp_Object Qtibetan, Qmyanmar, Qgeorgian, Qhangul, Qethiopic; +static Lisp_Object Qcherokee, Qcanadian_aboriginal, Qogham, Qrunic; +static Lisp_Object Qkhmer, Qmongolian, Qsymbol, Qbraille, Qhan; +static Lisp_Object Qideographic_description, Qcjk_misc, Qkana, Qbopomofo; +static Lisp_Object Qkanbun, Qyi, Qbyzantine_musical_symbol; +static Lisp_Object Qmusical_symbol, Qmathematical; + +/* Font spacing symbols - defined in font.c. */ +extern Lisp_Object Qc, Qp, Qm; + +static void fill_in_logfont P_ ((FRAME_PTR f, LOGFONT *logfont, + Lisp_Object font_spec)); + +static BYTE w32_antialias_type P_ ((Lisp_Object type)); +static Lisp_Object lispy_antialias_type P_ ((BYTE type)); + +static Lisp_Object font_supported_scripts P_ ((FONTSIGNATURE * sig)); + +/* From old font code in w32fns.c */ +char * w32_to_x_charset P_ ((int charset, char * matching)); + +static Lisp_Object w32_registry P_ ((LONG w32_charset)); + +/* EnumFontFamiliesEx callbacks. */ +static int CALLBACK add_font_entity_to_list P_ ((ENUMLOGFONTEX *, + NEWTEXTMETRICEX *, + DWORD, LPARAM)); +static int CALLBACK add_one_font_entity_to_list P_ ((ENUMLOGFONTEX *, + NEWTEXTMETRICEX *, + DWORD, LPARAM)); +static int CALLBACK add_font_name_to_list P_ ((ENUMLOGFONTEX *, + NEWTEXTMETRICEX *, + DWORD, LPARAM)); + +/* struct passed in as LPARAM arg to EnumFontFamiliesEx, for keeping track + of what we really want. */ +struct font_callback_data +{ + /* The logfont we are matching against. EnumFontFamiliesEx only matches + face name and charset, so we need to manually match everything else + in the callback function. */ + LOGFONT pattern; + /* The original font spec or entity. */ + Lisp_Object orig_font_spec; + /* The frame the font is being loaded on. */ + Lisp_Object frame; + /* The list to add matches to. */ + Lisp_Object list; + /* Whether to match only opentype fonts. */ + int opentype_only; +}; + +/* Handles the problem that EnumFontFamiliesEx will not return all + style variations if the font name is not specified. */ +static void list_all_matching_fonts P_ ((struct font_callback_data *match)); + + +/* MingW headers only define this when _WIN32_WINNT >= 0x0500, but we + target older versions. */ +#ifndef GGI_MARK_NONEXISTING_GLYPHS +#define GGI_MARK_NONEXISTING_GLYPHS 1 +#endif + +static int +memq_no_quit (elt, list) + Lisp_Object elt, list; +{ + while (CONSP (list) && ! EQ (XCAR (list), elt)) + list = XCDR (list); + return (CONSP (list)); +} + +/* w32 implementation of get_cache for font backend. + Return a cache of font-entities on FRAME. The cache must be a + cons whose cdr part is the actual cache area. */ +Lisp_Object +w32font_get_cache (f) + FRAME_PTR f; +{ + struct w32_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + + return (dpyinfo->name_list_element); +} + +/* w32 implementation of list for font backend. + List fonts exactly matching with FONT_SPEC on FRAME. The value + is a vector of font-entities. This is the sole API that + allocates font-entities. */ +static Lisp_Object +w32font_list (frame, font_spec) + Lisp_Object frame, font_spec; +{ + return w32font_list_internal (frame, font_spec, 0); +} + +/* w32 implementation of match for font backend. + Return a font entity most closely matching with FONT_SPEC on + FRAME. The closeness is detemined by the font backend, thus + `face-font-selection-order' is ignored here. */ +static Lisp_Object +w32font_match (frame, font_spec) + Lisp_Object frame, font_spec; +{ + return w32font_match_internal (frame, font_spec, 0); +} + +/* w32 implementation of list_family for font backend. + List available families. The value is a list of family names + (symbols). */ +static Lisp_Object +w32font_list_family (frame) + Lisp_Object frame; +{ + Lisp_Object list = Qnil; + LOGFONT font_match_pattern; + HDC dc; + FRAME_PTR f = XFRAME (frame); + + bzero (&font_match_pattern, sizeof (font_match_pattern)); + + dc = get_frame_dc (f); + + EnumFontFamiliesEx (dc, &font_match_pattern, + (FONTENUMPROC) add_font_name_to_list, + (LPARAM) &list, 0); + release_frame_dc (f, dc); + + return list; +} + +/* w32 implementation of open for font backend. + Open a font specified by FONT_ENTITY on frame F. + If the font is scalable, open it with PIXEL_SIZE. */ +static struct font * +w32font_open (f, font_entity, pixel_size) + FRAME_PTR f; + Lisp_Object font_entity; + int pixel_size; +{ + struct w32font_info *w32_font = xmalloc (sizeof (struct w32font_info)); + + if (w32_font == NULL) + return NULL; + + if (!w32font_open_internal (f, font_entity, pixel_size, w32_font)) + { + xfree (w32_font); + return NULL; + } + + return (struct font *) w32_font; +} + +/* w32 implementation of close for font_backend. + Close FONT on frame F. */ +void +w32font_close (f, font) + FRAME_PTR f; + struct font *font; +{ + if (font->font.font) + { + W32FontStruct *old_w32_font = (W32FontStruct *)font->font.font; + DeleteObject (old_w32_font->hfont); + xfree (old_w32_font); + font->font.font = 0; + } + + if (font->font.name) + xfree (font->font.name); + xfree (font); +} + +/* w32 implementation of has_char for font backend. + Optional. + If FONT_ENTITY has a glyph for character C (Unicode code point), + return 1. If not, return 0. If a font must be opened to check + it, return -1. */ +int +w32font_has_char (entity, c) + Lisp_Object entity; + int c; +{ + Lisp_Object supported_scripts, extra, script; + DWORD mask; + + extra = AREF (entity, FONT_EXTRA_INDEX); + if (!CONSP (extra)) + return -1; + + supported_scripts = assq_no_quit (QCscript, extra); + if (!CONSP (supported_scripts)) + return -1; + + supported_scripts = XCDR (supported_scripts); + + script = CHAR_TABLE_REF (Vchar_script_table, c); + + return (memq_no_quit (script, supported_scripts)) ? 1 : 0; +} + +/* w32 implementation of encode_char for font backend. + Return a glyph code of FONT for characer C (Unicode code point). + If FONT doesn't have such a glyph, return FONT_INVALID_CODE. */ +unsigned +w32font_encode_char (font, c) + struct font *font; + int c; +{ + /* Avoid unneccesary conversion - all the Win32 APIs will take a unicode + character. */ + return c; +} + +/* w32 implementation of text_extents for font backend. + Perform the size computation of glyphs of FONT and fillin members + of METRICS. The glyphs are specified by their glyph codes in + CODE (length NGLYPHS). Apparently metrics can be NULL, in this + case just return the overall width. */ +int +w32font_text_extents (font, code, nglyphs, metrics) + struct font *font; + unsigned *code; + int nglyphs; + struct font_metrics *metrics; +{ + int i; + HFONT old_font; + HDC dc; + struct frame * f; + int total_width = 0; + WORD *wcode = alloca(nglyphs * sizeof (WORD)); + SIZE size; + +#if 0 + /* Frames can come and go, and their fonts outlive them. This is + particularly troublesome with tooltip frames, and causes crashes. */ + f = ((struct w32font_info *)font)->owning_frame; +#else + f = XFRAME (selected_frame); +#endif + + dc = get_frame_dc (f); + old_font = SelectObject (dc, ((W32FontStruct *)(font->font.font))->hfont); + + if (metrics) + { + GLYPHMETRICS gm; + MAT2 transform; + + /* Set transform to the identity matrix. */ + bzero (&transform, sizeof (transform)); + transform.eM11.value = 1; + transform.eM22.value = 1; + metrics->width = 0; + metrics->ascent = 0; + metrics->descent = 0; + + for (i = 0; i < nglyphs; i++) + { + if (GetGlyphOutlineW (dc, *(code + i), GGO_METRICS, &gm, 0, + NULL, &transform) != GDI_ERROR) + { + int new_val = metrics->width + gm.gmBlackBoxX + + gm.gmptGlyphOrigin.x; + + metrics->rbearing = max (metrics->rbearing, new_val); + metrics->width += gm.gmCellIncX; + new_val = -gm.gmptGlyphOrigin.y; + metrics->ascent = max (metrics->ascent, new_val); + new_val = gm.gmBlackBoxY + gm.gmptGlyphOrigin.y; + metrics->descent = max (metrics->descent, new_val); + } + else + { + /* Rely on an estimate based on the overall font metrics. */ + break; + } + } + + /* If we got through everything, return. */ + if (i == nglyphs) + { + /* Restore state and release DC. */ + SelectObject (dc, old_font); + release_frame_dc (f, dc); + + return metrics->width; + } + } + + for (i = 0; i < nglyphs; i++) + { + if (code[i] < 0x10000) + wcode[i] = code[i]; + else + { + /* TODO: Convert to surrogate, reallocating array if needed */ + wcode[i] = 0xffff; + } + } + + if (GetTextExtentPoint32W (dc, wcode, nglyphs, &size)) + { + total_width = size.cx; + } + + if (!total_width) + { + RECT rect; + rect.top = 0; rect.bottom = font->font.height; rect.left = 0; rect.right = 1; + DrawTextW (dc, wcode, nglyphs, &rect, + DT_CALCRECT | DT_NOPREFIX | DT_SINGLELINE); + total_width = rect.right; + } + + if (metrics) + { + metrics->width = total_width; + metrics->ascent = font->ascent; + metrics->descent = font->descent; + metrics->lbearing = 0; + metrics->rbearing = total_width + + ((struct w32font_info *) font)->metrics.tmOverhang; + } + + /* Restore state and release DC. */ + SelectObject (dc, old_font); + release_frame_dc (f, dc); + + return total_width; +} + +/* w32 implementation of draw for font backend. + Optional. + Draw glyphs between FROM and TO of S->char2b at (X Y) pixel + position of frame F with S->FACE and S->GC. If WITH_BACKGROUND + is nonzero, fill the background in advance. It is assured that + WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars). + + TODO: Currently this assumes that the colors and fonts are already + set in the DC. This seems to be true now, but maybe only due to + the old font code setting it up. It may be safer to resolve faces + and fonts in here and set them explicitly +*/ + +int +w32font_draw (s, from, to, x, y, with_background) + struct glyph_string *s; + int from, to, x, y, with_background; +{ + UINT options = 0; + HRGN orig_clip; + + /* Save clip region for later restoration. */ + GetClipRgn(s->hdc, orig_clip); + + if (s->num_clips > 0) + { + HRGN new_clip = CreateRectRgnIndirect (s->clip); + + if (s->num_clips > 1) + { + HRGN clip2 = CreateRectRgnIndirect (s->clip + 1); + + CombineRgn (new_clip, new_clip, clip2, RGN_OR); + DeleteObject (clip2); + } + + SelectClipRgn (s->hdc, new_clip); + DeleteObject (new_clip); + } + + /* Using OPAQUE background mode can clear more background than expected + when Cleartype is used. Draw the background manually to avoid this. */ + SetBkMode (s->hdc, TRANSPARENT); + if (with_background) + { + HBRUSH brush; + RECT rect; + struct font *font = (struct font *) s->face->font_info; + + brush = CreateSolidBrush (s->gc->background); + rect.left = x; + rect.top = y - font->ascent; + rect.right = x + s->width; + rect.bottom = y + font->descent; + FillRect (s->hdc, &rect, brush); + DeleteObject (brush); + } + + ExtTextOutW (s->hdc, x, y, options, NULL, s->char2b + from, to - from, NULL); + + /* Restore clip region. */ + if (s->num_clips > 0) + { + SelectClipRgn (s->hdc, orig_clip); + } +} + +/* w32 implementation of free_entity for font backend. + Optional (if FONT_EXTRA_INDEX is not Lisp_Save_Value). + Free FONT_EXTRA_INDEX field of FONT_ENTITY. +static void +w32font_free_entity (Lisp_Object entity); + */ + +/* w32 implementation of prepare_face for font backend. + Optional (if FACE->extra is not used). + Prepare FACE for displaying characters by FONT on frame F by + storing some data in FACE->extra. If successful, return 0. + Otherwise, return -1. +static int +w32font_prepare_face (FRAME_PTR f, struct face *face); + */ +/* w32 implementation of done_face for font backend. + Optional. + Done FACE for displaying characters by FACE->font on frame F. +static void +w32font_done_face (FRAME_PTR f, struct face *face); */ + +/* w32 implementation of get_bitmap for font backend. + Optional. + Store bitmap data for glyph-code CODE of FONT in BITMAP. It is + intended that this method is called from the other font-driver + for actual drawing. +static int +w32font_get_bitmap (struct font *font, unsigned code, + struct font_bitmap *bitmap, int bits_per_pixel); + */ +/* w32 implementation of free_bitmap for font backend. + Optional. + Free bitmap data in BITMAP. +static void +w32font_free_bitmap (struct font *font, struct font_bitmap *bitmap); + */ +/* w32 implementation of get_outline for font backend. + Optional. + Return an outline data for glyph-code CODE of FONT. The format + of the outline data depends on the font-driver. +static void * +w32font_get_outline (struct font *font, unsigned code); + */ +/* w32 implementation of free_outline for font backend. + Optional. + Free OUTLINE (that is obtained by the above method). +static void +w32font_free_outline (struct font *font, void *outline); + */ +/* w32 implementation of anchor_point for font backend. + Optional. + Get coordinates of the INDEXth anchor point of the glyph whose + code is CODE. Store the coordinates in *X and *Y. Return 0 if + the operations was successfull. Otherwise return -1. +static int +w32font_anchor_point (struct font *font, unsigned code, + int index, int *x, int *y); + */ +/* w32 implementation of otf_capability for font backend. + Optional. + Return a list describing which scripts/languages FONT + supports by which GSUB/GPOS features of OpenType tables. +static Lisp_Object +w32font_otf_capability (struct font *font); + */ +/* w32 implementation of otf_drive for font backend. + Optional. + Apply FONT's OTF-FEATURES to the glyph string. + + FEATURES specifies which OTF features to apply in this format: + (SCRIPT LANGSYS GSUB-FEATURE GPOS-FEATURE) + See the documentation of `font-drive-otf' for the detail. + + This method applies the specified features to the codes in the + elements of GSTRING-IN (between FROMth and TOth). The output + codes are stored in GSTRING-OUT at the IDXth element and the + following elements. + + Return the number of output codes. If none of the features are + applicable to the input data, return 0. If GSTRING-OUT is too + short, return -1. +static int +w32font_otf_drive (struct font *font, Lisp_Object features, + Lisp_Object gstring_in, int from, int to, + Lisp_Object gstring_out, int idx, + int alternate_subst); + */ + +/* Internal implementation of w32font_list. + Additional parameter opentype_only restricts the returned fonts to + opentype fonts, which can be used with the Uniscribe backend. */ +Lisp_Object +w32font_list_internal (frame, font_spec, opentype_only) + Lisp_Object frame, font_spec; + int opentype_only; +{ + struct font_callback_data match_data; + HDC dc; + FRAME_PTR f = XFRAME (frame); + + match_data.orig_font_spec = font_spec; + match_data.list = Qnil; + match_data.frame = frame; + + bzero (&match_data.pattern, sizeof (LOGFONT)); + fill_in_logfont (f, &match_data.pattern, font_spec); + + match_data.opentype_only = opentype_only; + if (opentype_only) + match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS; + + if (match_data.pattern.lfFaceName[0] == '\0') + { + /* EnumFontFamiliesEx does not take other fields into account if + font name is blank, so need to use two passes. */ + list_all_matching_fonts (&match_data); + } + else + { + dc = get_frame_dc (f); + + EnumFontFamiliesEx (dc, &match_data.pattern, + (FONTENUMPROC) add_font_entity_to_list, + (LPARAM) &match_data, 0); + release_frame_dc (f, dc); + } + + return NILP (match_data.list) ? null_vector : Fvconcat (1, &match_data.list); +} + +/* Internal implementation of w32font_match. + Additional parameter opentype_only restricts the returned fonts to + opentype fonts, which can be used with the Uniscribe backend. */ +Lisp_Object +w32font_match_internal (frame, font_spec, opentype_only) + Lisp_Object frame, font_spec; + int opentype_only; +{ + struct font_callback_data match_data; + HDC dc; + FRAME_PTR f = XFRAME (frame); + + match_data.orig_font_spec = font_spec; + match_data.frame = frame; + match_data.list = Qnil; + + bzero (&match_data.pattern, sizeof (LOGFONT)); + fill_in_logfont (f, &match_data.pattern, font_spec); + + match_data.opentype_only = opentype_only; + if (opentype_only) + match_data.pattern.lfOutPrecision = OUT_OUTLINE_PRECIS; + + dc = get_frame_dc (f); + + EnumFontFamiliesEx (dc, &match_data.pattern, + (FONTENUMPROC) add_one_font_entity_to_list, + (LPARAM) &match_data, 0); + release_frame_dc (f, dc); + + return NILP (match_data.list) ? Qnil : XCAR (match_data.list); +} + +int +w32font_open_internal (f, font_entity, pixel_size, w32_font) + FRAME_PTR f; + Lisp_Object font_entity; + int pixel_size; + struct w32font_info *w32_font; +{ + int len, size; + LOGFONT logfont; + HDC dc; + HFONT hfont, old_font; + Lisp_Object val, extra; + /* For backwards compatibility. */ + W32FontStruct *compat_w32_font; + + struct font * font = (struct font *) w32_font; + if (!font) + return 0; + + bzero (&logfont, sizeof (logfont)); + fill_in_logfont (f, &logfont, font_entity); + + size = XINT (AREF (font_entity, FONT_SIZE_INDEX)); + if (!size) + size = pixel_size; + + logfont.lfHeight = -size; + hfont = CreateFontIndirect (&logfont); + + if (hfont == NULL) + return 0; + + w32_font->owning_frame = f; + + /* Get the metrics for this font. */ + dc = get_frame_dc (f); + old_font = SelectObject (dc, hfont); + + GetTextMetrics (dc, &w32_font->metrics); + + SelectObject (dc, old_font); + release_frame_dc (f, dc); + /* W32FontStruct - we should get rid of this, and use the w32font_info + struct for any W32 specific fields. font->font.font can then be hfont. */ + font->font.font = xmalloc (sizeof (W32FontStruct)); + compat_w32_font = (W32FontStruct *) font->font.font; + bzero (compat_w32_font, sizeof (W32FontStruct)); + compat_w32_font->font_type = UNICODE_FONT; + /* Duplicate the text metrics. */ + bcopy (&w32_font->metrics, &compat_w32_font->tm, sizeof (TEXTMETRIC)); + compat_w32_font->hfont = hfont; + + len = strlen (logfont.lfFaceName); + font->font.name = (char *) xmalloc (len + 1); + bcopy (logfont.lfFaceName, font->font.name, len); + font->font.name[len] = '\0'; + font->font.full_name = font->font.name; + font->font.charset = 0; + font->font.codepage = 0; + font->font.size = w32_font->metrics.tmMaxCharWidth; + font->font.height = w32_font->metrics.tmHeight + + w32_font->metrics.tmExternalLeading; + font->font.space_width = font->font.average_width + = w32_font->metrics.tmAveCharWidth; + + font->font.vertical_centering = 0; + font->font.encoding_type = 0; + font->font.baseline_offset = 0; + font->font.relative_compose = 0; + font->font.default_ascent = w32_font->metrics.tmAscent; + font->font.font_encoder = NULL; + font->entity = font_entity; + font->pixel_size = size; + font->driver = &w32font_driver; + font->format = Qgdi; + font->file_name = NULL; + font->encoding_charset = -1; + font->repertory_charset = -1; + font->min_width = 0; + font->ascent = w32_font->metrics.tmAscent; + font->descent = w32_font->metrics.tmDescent; + font->scalable = w32_font->metrics.tmPitchAndFamily & TMPF_VECTOR; + + return 1; +} + +/* Callback function for EnumFontFamiliesEx. + * Adds the name of a font to a Lisp list (passed in as the lParam arg). */ +static int CALLBACK +add_font_name_to_list (logical_font, physical_font, font_type, list_object) + ENUMLOGFONTEX *logical_font; + NEWTEXTMETRICEX *physical_font; + DWORD font_type; + LPARAM list_object; +{ + Lisp_Object* list = (Lisp_Object *) list_object; + Lisp_Object family; + + /* Skip vertical fonts (intended only for printing) */ + if (logical_font->elfLogFont.lfFaceName[0] == '@') + return 1; + + family = intern_downcase (logical_font->elfLogFont.lfFaceName, + strlen (logical_font->elfLogFont.lfFaceName)); + if (! memq_no_quit (family, *list)) + *list = Fcons (family, *list); + + return 1; +} + +/* Convert an enumerated Windows font to an Emacs font entity. */ +static Lisp_Object +w32_enumfont_pattern_entity (frame, logical_font, physical_font, + font_type, requested_font) + Lisp_Object frame; + ENUMLOGFONTEX *logical_font; + NEWTEXTMETRICEX *physical_font; + DWORD font_type; + LOGFONT *requested_font; +{ + Lisp_Object entity, tem; + LOGFONT *lf = (LOGFONT*) logical_font; + BYTE generic_type; + + entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil); + + ASET (entity, FONT_TYPE_INDEX, Qgdi); + ASET (entity, FONT_FRAME_INDEX, frame); + ASET (entity, FONT_REGISTRY_INDEX, w32_registry (lf->lfCharSet)); + ASET (entity, FONT_OBJLIST_INDEX, Qnil); + + /* Foundry is difficult to get in readable form on Windows. + But Emacs crashes if it is not set, so set it to something more + generic. Thes values make xflds compatible with Emacs 22. */ + if (lf->lfOutPrecision == OUT_STRING_PRECIS) + tem = Qraster; + else if (lf->lfOutPrecision == OUT_STROKE_PRECIS) + tem = Qoutline; + else + tem = Qunknown; + + ASET (entity, FONT_FOUNDRY_INDEX, tem); + + /* Save the generic family in the extra info, as it is likely to be + useful to users looking for a close match. */ + generic_type = physical_font->ntmTm.tmPitchAndFamily & 0xF0; + if (generic_type == FF_DECORATIVE) + tem = Qdecorative; + else if (generic_type == FF_MODERN) + tem = Qmono; + else if (generic_type == FF_ROMAN) + tem = Qserif; + else if (generic_type == FF_SCRIPT) + tem = Qscript; + else if (generic_type == FF_SWISS) + tem = Qsans; + else + tem = null_string; + + ASET (entity, FONT_ADSTYLE_INDEX, tem); + + if (physical_font->ntmTm.tmPitchAndFamily & 0x01) + font_put_extra (entity, QCspacing, make_number (FONT_SPACING_PROPORTIONAL)); + else + font_put_extra (entity, QCspacing, make_number (FONT_SPACING_MONO)); + + if (requested_font->lfQuality != DEFAULT_QUALITY) + { + font_put_extra (entity, QCantialias, + lispy_antialias_type (requested_font->lfQuality)); + } + ASET (entity, FONT_FAMILY_INDEX, + intern_downcase (lf->lfFaceName, strlen (lf->lfFaceName))); + + ASET (entity, FONT_WEIGHT_INDEX, make_number (lf->lfWeight)); + ASET (entity, FONT_SLANT_INDEX, make_number (lf->lfItalic ? 200 : 100)); + /* TODO: PANOSE struct has this info, but need to call GetOutlineTextMetrics + to get it. */ + ASET (entity, FONT_WIDTH_INDEX, make_number (100)); + + if (font_type & RASTER_FONTTYPE) + ASET (entity, FONT_SIZE_INDEX, make_number (physical_font->ntmTm.tmHeight)); + else + ASET (entity, FONT_SIZE_INDEX, make_number (0)); + + /* Cache unicode codepoints covered by this font, as there is no other way + of getting this information easily. */ + if (font_type & TRUETYPE_FONTTYPE) + { + font_put_extra (entity, QCscript, + font_supported_scripts (&physical_font->ntmFontSig)); + } + + return entity; +} + + +/* Convert generic families to the family portion of lfPitchAndFamily. */ +BYTE +w32_generic_family (Lisp_Object name) +{ + /* Generic families. */ + if (EQ (name, Qmonospace) || EQ (name, Qmono)) + return FF_MODERN; + else if (EQ (name, Qsans) || EQ (name, Qsans_serif) || EQ (name, Qsansserif)) + return FF_SWISS; + else if (EQ (name, Qserif)) + return FF_ROMAN; + else if (EQ (name, Qdecorative)) + return FF_DECORATIVE; + else if (EQ (name, Qscript)) + return FF_SCRIPT; + else + return FF_DONTCARE; +} + +static int +logfonts_match (font, pattern) + LOGFONT *font, *pattern; +{ + /* Only check height for raster fonts. */ + if (pattern->lfHeight && font->lfOutPrecision == OUT_STRING_PRECIS + && font->lfHeight != pattern->lfHeight) + return 0; + + /* Have some flexibility with weights. */ + if (pattern->lfWeight + && ((font->lfWeight < (pattern->lfWeight - 150)) + || font->lfWeight > (pattern->lfWeight + 150))) + return 0; + + /* Charset and face should be OK. Italic has to be checked + against the original spec, in case we don't have any preference. */ + return 1; +} + +static int +font_matches_spec (type, font, spec) + DWORD type; + NEWTEXTMETRICEX *font; + Lisp_Object spec; +{ + Lisp_Object extra, val; + + /* Check italic. Can't check logfonts, since it is a boolean field, + so there is no difference between "non-italic" and "don't care". */ + val = AREF (spec, FONT_SLANT_INDEX); + if (INTEGERP (val)) + { + int slant = XINT (val); + if ((slant > 150 && !font->ntmTm.tmItalic) + || (slant <= 150 && font->ntmTm.tmItalic)) + return 0; + } + + /* Check adstyle against generic family. */ + val = AREF (spec, FONT_ADSTYLE_INDEX); + if (!NILP (val)) + { + BYTE family = w32_generic_family (val); + if (family != FF_DONTCARE + && family != (font->ntmTm.tmPitchAndFamily & 0xF0)) + return 0; + } + + /* Check extra parameters. */ + for (extra = AREF (spec, FONT_EXTRA_INDEX); + CONSP (extra); extra = XCDR (extra)) + { + Lisp_Object extra_entry; + extra_entry = XCAR (extra); + if (CONSP (extra_entry)) + { + Lisp_Object key = XCAR (extra_entry); + val = XCDR (extra_entry); + if (EQ (key, QCspacing)) + { + int proportional; + if (INTEGERP (val)) + { + int spacing = XINT (val); + proportional = (spacing < FONT_SPACING_MONO); + } + else if (EQ (val, Qp)) + proportional = 1; + else if (EQ (val, Qc) || EQ (val, Qm)) + proportional = 0; + else + return 0; /* Bad font spec. */ + + if ((proportional && !(font->ntmTm.tmPitchAndFamily & 0x01)) + || (!proportional && (font->ntmTm.tmPitchAndFamily & 0x01))) + return 0; + } + else if (EQ (key, QCscript) && SYMBOLP (val)) + { + /* Only truetype fonts will have information about what + scripts they support. This probably means the user + will have to force Emacs to use raster, postscript + or atm fonts for non-ASCII text. */ + if (type & TRUETYPE_FONTTYPE) + { + Lisp_Object support + = font_supported_scripts (&font->ntmFontSig); + if (! memq_no_quit (val, support)) + return 0; + } + else + { + /* Return specific matches, but play it safe. Fonts + that cover more than their charset would suggest + are likely to be truetype or opentype fonts, + covered above. */ + if (EQ (val, Qlatin)) + { + /* Although every charset but symbol, thai and + arabic contains the basic ASCII set of latin + characters, Emacs expects much more. */ + if (font->ntmTm.tmCharSet != ANSI_CHARSET) + return 0; + } + else if (EQ (val, Qsymbol)) + { + if (font->ntmTm.tmCharSet != SYMBOL_CHARSET) + return 0; + } + else if (EQ (val, Qcyrillic)) + { + if (font->ntmTm.tmCharSet != RUSSIAN_CHARSET) + return 0; + } + else if (EQ (val, Qgreek)) + { + if (font->ntmTm.tmCharSet != GREEK_CHARSET) + return 0; + } + else if (EQ (val, Qarabic)) + { + if (font->ntmTm.tmCharSet != ARABIC_CHARSET) + return 0; + } + else if (EQ (val, Qhebrew)) + { + if (font->ntmTm.tmCharSet != HEBREW_CHARSET) + return 0; + } + else if (EQ (val, Qthai)) + { + if (font->ntmTm.tmCharSet != THAI_CHARSET) + return 0; + } + else if (EQ (val, Qkana)) + { + if (font->ntmTm.tmCharSet != SHIFTJIS_CHARSET) + return 0; + } + else if (EQ (val, Qbopomofo)) + { + if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET) + return 0; + } + else if (EQ (val, Qhangul)) + { + if (font->ntmTm.tmCharSet != HANGUL_CHARSET + && font->ntmTm.tmCharSet != JOHAB_CHARSET) + return 0; + } + else if (EQ (val, Qhan)) + { + if (font->ntmTm.tmCharSet != CHINESEBIG5_CHARSET + && font->ntmTm.tmCharSet != GB2312_CHARSET + && font->ntmTm.tmCharSet != HANGUL_CHARSET + && font->ntmTm.tmCharSet != JOHAB_CHARSET + && font->ntmTm.tmCharSet != SHIFTJIS_CHARSET) + return 0; + } + else + /* Other scripts unlikely to be handled. */ + return 0; + } + } + } + } + return 1; +} + +/* Callback function for EnumFontFamiliesEx. + * Checks if a font matches everything we are trying to check agaist, + * and if so, adds it to a list. Both the data we are checking against + * and the list to which the fonts are added are passed in via the + * lparam argument, in the form of a font_callback_data struct. */ +static int CALLBACK +add_font_entity_to_list (logical_font, physical_font, font_type, lParam) + ENUMLOGFONTEX *logical_font; + NEWTEXTMETRICEX *physical_font; + DWORD font_type; + LPARAM lParam; +{ + struct font_callback_data *match_data + = (struct font_callback_data *) lParam; + + if ((!match_data->opentype_only + || (physical_font->ntmTm.ntmFlags & NTMFLAGS_OPENTYPE)) + && logfonts_match (&logical_font->elfLogFont, &match_data->pattern) + && font_matches_spec (font_type, physical_font, + match_data->orig_font_spec) + /* Avoid substitutions involving raster fonts (eg Helv -> MS Sans Serif) + We limit this to raster fonts, because the test can catch some + genuine fonts (eg the full name of DejaVu Sans Mono Light is actually + DejaVu Sans Mono ExtraLight). Helvetica -> Arial substitution will + therefore get through this test. Since full names can be prefixed + by a foundry, we accept raster fonts if the font name is found + anywhere within the full name. */ + && (logical_font->elfLogFont.lfOutPrecision != OUT_STRING_PRECIS + || strstr (logical_font->elfFullName, + logical_font->elfLogFont.lfFaceName))) + { + Lisp_Object entity + = w32_enumfont_pattern_entity (match_data->frame, logical_font, + physical_font, font_type, + &match_data->pattern); + if (!NILP (entity)) + match_data->list = Fcons (entity, match_data->list); + } + return 1; +} + +/* Callback function for EnumFontFamiliesEx. + * Terminates the search once we have a match. */ +static int CALLBACK +add_one_font_entity_to_list (logical_font, physical_font, font_type, lParam) + ENUMLOGFONTEX *logical_font; + NEWTEXTMETRICEX *physical_font; + DWORD font_type; + LPARAM lParam; +{ + struct font_callback_data *match_data + = (struct font_callback_data *) lParam; + add_font_entity_to_list (logical_font, physical_font, font_type, lParam); + + /* If we have a font in the list, terminate the search. */ + return !NILP (match_data->list); +} + +/* Convert a Lisp font registry (symbol) to a windows charset. */ +static LONG +registry_to_w32_charset (charset) + Lisp_Object charset; +{ + if (EQ (charset, Qiso10646_1) || EQ (charset, Qunicode_bmp) + || EQ (charset, Qunicode_sip)) + return DEFAULT_CHARSET; /* UNICODE_CHARSET not defined in MingW32 */ + else if (EQ (charset, Qiso8859_1)) + return ANSI_CHARSET; + else if (SYMBOLP (charset)) + return x_to_w32_charset (SDATA (SYMBOL_NAME (charset))); + else if (STRINGP (charset)) + return x_to_w32_charset (SDATA (charset)); + else + return DEFAULT_CHARSET; +} + +static Lisp_Object +w32_registry (w32_charset) + LONG w32_charset; +{ + if (w32_charset == ANSI_CHARSET) + return Qiso10646_1; + else + { + char * charset = w32_to_x_charset (w32_charset, NULL); + return intern_downcase (charset, strlen(charset)); + } +} + +/* Fill in all the available details of LOGFONT from FONT_SPEC. */ +static void +fill_in_logfont (f, logfont, font_spec) + FRAME_PTR f; + LOGFONT *logfont; + Lisp_Object font_spec; +{ + Lisp_Object tmp, extra; + int dpi = FRAME_W32_DISPLAY_INFO (f)->resy; + + extra = AREF (font_spec, FONT_EXTRA_INDEX); + /* Allow user to override dpi settings. */ + if (CONSP (extra)) + { + tmp = assq_no_quit (QCdpi, extra); + if (CONSP (tmp) && INTEGERP (XCDR (tmp))) + { + dpi = XINT (XCDR (tmp)); + } + else if (CONSP (tmp) && FLOATP (XCDR (tmp))) + { + dpi = (int) (XFLOAT_DATA (XCDR (tmp)) + 0.5); + } + } + + /* Height */ + tmp = AREF (font_spec, FONT_SIZE_INDEX); + if (INTEGERP (tmp)) + logfont->lfHeight = -1 * XINT (tmp); + else if (FLOATP (tmp)) + logfont->lfHeight = (int) (-1.0 * dpi * XFLOAT_DATA (tmp) / 72.27 + 0.5); + + /* Escapement */ + + /* Orientation */ + + /* Weight */ + tmp = AREF (font_spec, FONT_WEIGHT_INDEX); + if (INTEGERP (tmp)) + logfont->lfWeight = XINT (tmp); + + /* Italic */ + tmp = AREF (font_spec, FONT_SLANT_INDEX); + if (INTEGERP (tmp)) + { + int slant = XINT (tmp); + logfont->lfItalic = slant > 150 ? 1 : 0; + } + + /* Underline */ + + /* Strikeout */ + + /* Charset */ + tmp = AREF (font_spec, FONT_REGISTRY_INDEX); + if (! NILP (tmp)) + logfont->lfCharSet = registry_to_w32_charset (tmp); + + /* Out Precision */ + + /* Clip Precision */ + + /* Quality */ + logfont->lfQuality = DEFAULT_QUALITY; + + /* Generic Family and Face Name */ + logfont->lfPitchAndFamily = FF_DONTCARE | DEFAULT_PITCH; + + tmp = AREF (font_spec, FONT_FAMILY_INDEX); + if (! NILP (tmp)) + { + logfont->lfPitchAndFamily = w32_generic_family (tmp) | DEFAULT_PITCH; + if ((logfont->lfPitchAndFamily & 0xF0) != FF_DONTCARE) + ; /* Font name was generic, don't fill in font name. */ + /* Font families are interned, but allow for strings also in case of + user input. */ + else if (SYMBOLP (tmp)) + strncpy (logfont->lfFaceName, SDATA (SYMBOL_NAME (tmp)), LF_FACESIZE); + else if (STRINGP (tmp)) + strncpy (logfont->lfFaceName, SDATA (tmp), LF_FACESIZE); + } + + tmp = AREF (font_spec, FONT_ADSTYLE_INDEX); + if (!NILP (tmp)) + { + /* Override generic family. */ + BYTE family = w32_generic_family (tmp); + if (family != FF_DONTCARE) + logfont->lfPitchAndFamily = family | DEFAULT_PITCH; + } + + /* Process EXTRA info. */ + for ( ; CONSP (extra); extra = XCDR (extra)) + { + tmp = XCAR (extra); + if (CONSP (tmp)) + { + Lisp_Object key, val; + key = XCAR (tmp), val = XCDR (tmp); + if (EQ (key, QCspacing)) + { + /* Set pitch based on the spacing property. */ + if (INTEGERP (val)) + { + int spacing = XINT (val); + if (spacing < FONT_SPACING_MONO) + logfont->lfPitchAndFamily + = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH; + else + logfont->lfPitchAndFamily + = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH; + } + else if (EQ (val, Qp)) + logfont->lfPitchAndFamily + = logfont->lfPitchAndFamily & 0xF0 | VARIABLE_PITCH; + else if (EQ (val, Qc) || EQ (val, Qm)) + logfont->lfPitchAndFamily + = logfont->lfPitchAndFamily & 0xF0 | FIXED_PITCH; + } + /* Only use QCscript if charset is not provided, or is unicode + and a single script is specified. This is rather crude, + and is only used to narrow down the fonts returned where + there is a definite match. Some scripts, such as latin, han, + cjk-misc match multiple lfCharSet values, so we can't pre-filter + them. */ + else if (EQ (key, QCscript) + && logfont->lfCharSet == DEFAULT_CHARSET + && SYMBOLP (val)) + { + if (EQ (val, Qgreek)) + logfont->lfCharSet = GREEK_CHARSET; + else if (EQ (val, Qhangul)) + logfont->lfCharSet = HANGUL_CHARSET; + else if (EQ (val, Qkana) || EQ (val, Qkanbun)) + logfont->lfCharSet = SHIFTJIS_CHARSET; + else if (EQ (val, Qbopomofo)) + logfont->lfCharSet = CHINESEBIG5_CHARSET; + /* GB 18030 supports tibetan, yi, mongolian, + fonts that support it should show up if we ask for + GB2312 fonts. */ + else if (EQ (val, Qtibetan) || EQ (val, Qyi) + || EQ (val, Qmongolian)) + logfont->lfCharSet = GB2312_CHARSET; + else if (EQ (val, Qhebrew)) + logfont->lfCharSet = HEBREW_CHARSET; + else if (EQ (val, Qarabic)) + logfont->lfCharSet = ARABIC_CHARSET; + else if (EQ (val, Qthai)) + logfont->lfCharSet = THAI_CHARSET; + else if (EQ (val, Qsymbol)) + logfont->lfCharSet = SYMBOL_CHARSET; + } + else if (EQ (key, QCantialias) && SYMBOLP (val)) + { + logfont->lfQuality = w32_antialias_type (val); + } + } + } +} + +static void +list_all_matching_fonts (match_data) + struct font_callback_data *match_data; +{ + HDC dc; + Lisp_Object families = w32font_list_family (match_data->frame); + struct frame *f = XFRAME (match_data->frame); + + dc = get_frame_dc (f); + + while (!NILP (families)) + { + /* TODO: Use the Unicode versions of the W32 APIs, so we can + handle non-ASCII font names. */ + char *name; + Lisp_Object family = CAR (families); + families = CDR (families); + if (NILP (family)) + continue; + else if (STRINGP (family)) + name = SDATA (family); + else + name = SDATA (SYMBOL_NAME (family)); + + strncpy (match_data->pattern.lfFaceName, name, LF_FACESIZE); + match_data->pattern.lfFaceName[LF_FACESIZE - 1] = '\0'; + + EnumFontFamiliesEx (dc, &match_data->pattern, + (FONTENUMPROC) add_font_entity_to_list, + (LPARAM) match_data, 0); + } + + release_frame_dc (f, dc); +} + +static Lisp_Object +lispy_antialias_type (type) + BYTE type; +{ + Lisp_Object lispy; + + switch (type) + { + case NONANTIALIASED_QUALITY: + lispy = Qnone; + break; + case ANTIALIASED_QUALITY: + lispy = Qstandard; + break; + case CLEARTYPE_QUALITY: + lispy = Qsubpixel; + break; + case CLEARTYPE_NATURAL_QUALITY: + lispy = Qnatural; + break; + default: + lispy = Qnil; + break; + } + return lispy; +} + +/* Convert antialiasing symbols to lfQuality */ +static BYTE +w32_antialias_type (type) + Lisp_Object type; +{ + if (EQ (type, Qnone)) + return NONANTIALIASED_QUALITY; + else if (EQ (type, Qstandard)) + return ANTIALIASED_QUALITY; + else if (EQ (type, Qsubpixel)) + return CLEARTYPE_QUALITY; + else if (EQ (type, Qnatural)) + return CLEARTYPE_NATURAL_QUALITY; + else + return DEFAULT_QUALITY; +} + +/* Return a list of all the scripts that the font supports. */ +static Lisp_Object +font_supported_scripts (FONTSIGNATURE * sig) +{ + DWORD * subranges = sig->fsUsb; + Lisp_Object supported = Qnil; + + /* Match a single subrange. SYM is set if bit N is set in subranges. */ +#define SUBRANGE(n,sym) \ + if (subranges[(n) / 32] & (1 << ((n) % 32))) \ + supported = Fcons ((sym), supported) + + /* Match multiple subranges. SYM is set if any MASK bit is set in + subranges[0 - 3]. */ +#define MASK_ANY(mask0,mask1,mask2,mask3,sym) \ + if ((subranges[0] & (mask0)) || (subranges[1] & (mask1)) \ + || (subranges[2] & (mask2)) || (subranges[3] & (mask3))) \ + supported = Fcons ((sym), supported) + + SUBRANGE (0, Qlatin); /* There are many others... */ + + SUBRANGE (7, Qgreek); + SUBRANGE (8, Qcoptic); + SUBRANGE (9, Qcyrillic); + SUBRANGE (10, Qarmenian); + SUBRANGE (11, Qhebrew); + SUBRANGE (13, Qarabic); + SUBRANGE (14, Qnko); + SUBRANGE (15, Qdevanagari); + SUBRANGE (16, Qbengali); + SUBRANGE (17, Qgurmukhi); + SUBRANGE (18, Qgujarati); + SUBRANGE (19, Qoriya); + SUBRANGE (20, Qtamil); + SUBRANGE (21, Qtelugu); + SUBRANGE (22, Qkannada); + SUBRANGE (23, Qmalayalam); + SUBRANGE (24, Qthai); + SUBRANGE (25, Qlao); + SUBRANGE (26, Qgeorgian); + + SUBRANGE (48, Qcjk_misc); + SUBRANGE (51, Qbopomofo); + SUBRANGE (54, Qkanbun); /* Is this right? */ + SUBRANGE (56, Qhangul); + + SUBRANGE (59, Qhan); /* There are others, but this is the main one. */ + SUBRANGE (59, Qideographic_description); /* Windows lumps this in */ + + SUBRANGE (70, Qtibetan); + SUBRANGE (71, Qsyriac); + SUBRANGE (72, Qthaana); + SUBRANGE (73, Qsinhala); + SUBRANGE (74, Qmyanmar); + SUBRANGE (75, Qethiopic); + SUBRANGE (76, Qcherokee); + SUBRANGE (77, Qcanadian_aboriginal); + SUBRANGE (78, Qogham); + SUBRANGE (79, Qrunic); + SUBRANGE (80, Qkhmer); + SUBRANGE (81, Qmongolian); + SUBRANGE (82, Qbraille); + SUBRANGE (83, Qyi); + + SUBRANGE (88, Qbyzantine_musical_symbol); + SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */ + + SUBRANGE (89, Qmathematical); + + /* Match either katakana or hiragana for kana. */ + MASK_ANY (0, 0x00060000, 0, 0, Qkana); + + /* There isn't really a main symbol range, so include symbol if any + relevant range is set. */ + MASK_ANY (0x8000000, 0x0000FFFF, 0, 0, Qsymbol); + +#undef SUBRANGE +#undef MASK_ANY + + return supported; +} + + +struct font_driver w32font_driver = + { + 0, /* Qgdi */ + w32font_get_cache, + w32font_list, + w32font_match, + w32font_list_family, + NULL, /* free_entity */ + w32font_open, + w32font_close, + NULL, /* prepare_face */ + NULL, /* done_face */ + w32font_has_char, + w32font_encode_char, + w32font_text_extents, + w32font_draw, + NULL, /* get_bitmap */ + NULL, /* free_bitmap */ + NULL, /* get_outline */ + NULL, /* free_outline */ + NULL, /* anchor_point */ + NULL, /* otf_capability */ + NULL, /* otf_drive */ + NULL, /* start_for_frame */ + NULL, /* end_for_frame */ + NULL /* shape */ + }; + + +/* Initialize state that does not change between invocations. This is only + called when Emacs is dumped. */ +void +syms_of_w32font () +{ + DEFSYM (Qgdi, "gdi"); + + /* Generic font families. */ + DEFSYM (Qmonospace, "monospace"); + DEFSYM (Qserif, "serif"); + DEFSYM (Qsansserif, "sansserif"); + DEFSYM (Qscript, "script"); + DEFSYM (Qdecorative, "decorative"); + /* Aliases. */ + DEFSYM (Qsans_serif, "sans_serif"); + DEFSYM (Qsans, "sans"); + DEFSYM (Qmono, "mono"); + + /* Fake foundries. */ + DEFSYM (Qraster, "raster"); + DEFSYM (Qoutline, "outline"); + DEFSYM (Qunknown, "unknown"); + + /* Antialiasing. */ + DEFSYM (Qstandard, "standard"); + DEFSYM (Qsubpixel, "subpixel"); + DEFSYM (Qnatural, "natural"); + + /* Scripts */ + DEFSYM (Qlatin, "latin"); + DEFSYM (Qgreek, "greek"); + DEFSYM (Qcoptic, "coptic"); + DEFSYM (Qcyrillic, "cyrillic"); + DEFSYM (Qarmenian, "armenian"); + DEFSYM (Qhebrew, "hebrew"); + DEFSYM (Qarabic, "arabic"); + DEFSYM (Qsyriac, "syriac"); + DEFSYM (Qnko, "nko"); + DEFSYM (Qthaana, "thaana"); + DEFSYM (Qdevanagari, "devanagari"); + DEFSYM (Qbengali, "bengali"); + DEFSYM (Qgurmukhi, "gurmukhi"); + DEFSYM (Qgujarati, "gujarati"); + DEFSYM (Qoriya, "oriya"); + DEFSYM (Qtamil, "tamil"); + DEFSYM (Qtelugu, "telugu"); + DEFSYM (Qkannada, "kannada"); + DEFSYM (Qmalayalam, "malayalam"); + DEFSYM (Qsinhala, "sinhala"); + DEFSYM (Qthai, "thai"); + DEFSYM (Qlao, "lao"); + DEFSYM (Qtibetan, "tibetan"); + DEFSYM (Qmyanmar, "myanmar"); + DEFSYM (Qgeorgian, "georgian"); + DEFSYM (Qhangul, "hangul"); + DEFSYM (Qethiopic, "ethiopic"); + DEFSYM (Qcherokee, "cherokee"); + DEFSYM (Qcanadian_aboriginal, "canadian-aboriginal"); + DEFSYM (Qogham, "ogham"); + DEFSYM (Qrunic, "runic"); + DEFSYM (Qkhmer, "khmer"); + DEFSYM (Qmongolian, "mongolian"); + DEFSYM (Qsymbol, "symbol"); + DEFSYM (Qbraille, "braille"); + DEFSYM (Qhan, "han"); + DEFSYM (Qideographic_description, "ideographic-description"); + DEFSYM (Qcjk_misc, "cjk-misc"); + DEFSYM (Qkana, "kana"); + DEFSYM (Qbopomofo, "bopomofo"); + DEFSYM (Qkanbun, "kanbun"); + DEFSYM (Qyi, "yi"); + DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol"); + DEFSYM (Qmusical_symbol, "musical-symbol"); + DEFSYM (Qmathematical, "mathematical"); + + w32font_driver.type = Qgdi; + register_font_driver (&w32font_driver, NULL); +} + +/* arch-tag: 65b8a3cd-46aa-4c0d-a1f3-99e75b9c07ee + (do not change this comment) */ diff --git a/src/w32font.h b/src/w32font.h new file mode 100644 index 00000000000..54aa5ef9b19 --- /dev/null +++ b/src/w32font.h @@ -0,0 +1,58 @@ +/* Shared GDI and Uniscribe Font backend declarations for the W32 API. + Copyright (C) 2007 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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#ifndef EMACS_W32FONT_H +#define EMACS_W32FONT_H + + +/* Bit 17 of ntmFlags in NEWTEXTMETRIC is set for Postscript OpenType fonts, + bit 18 for Truetype OpenType fonts. */ +#define NTMFLAGS_OPENTYPE 0x60000 + +/* The actual structure for a w32 font, that can be cast to struct font. + The Uniscribe backend extends this. */ +struct w32font_info +{ + struct font font; + TEXTMETRIC metrics; + struct frame *owning_frame; +}; + +Lisp_Object w32font_get_cache P_ ((FRAME_PTR fe)); +Lisp_Object w32font_list_internal P_ ((Lisp_Object frame, + Lisp_Object font_spec, + int opentype_only)); +Lisp_Object w32font_match_internal P_ ((Lisp_Object frame, + Lisp_Object font_spec, + int opentype_only)); +int w32font_open_internal P_ ((FRAME_PTR f, Lisp_Object font_entity, + int pixel_size, struct w32font_info *w32_font)); +void w32font_close P_ ((FRAME_PTR f, struct font *font)); +int w32font_has_char P_ ((Lisp_Object entity, int c)); +unsigned w32font_encode_char P_ ((struct font *font, int c)); +int w32font_text_extents P_ ((struct font *font, unsigned *code, int nglyphs, + struct font_metrics *metrics)); +int w32font_draw P_ ((struct glyph_string *s, int from, int to, + int x, int y, int with_background)); + +#endif + +/* arch-tag: ef9d9675-a2a5-4d01-9526-815e9a3da7cb + (do not change this comment) */ diff --git a/src/w32menu.c b/src/w32menu.c index a0ce8c655cb..c570385c3bb 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -34,6 +34,7 @@ Boston, MA 02110-1301, USA. */ #include "blockinput.h" #include "buffer.h" #include "charset.h" +#include "character.h" #include "coding.h" /* This may include sys/types.h, and that somehow loses @@ -259,10 +260,10 @@ menubar_id_to_frame (id) Lisp_Object tail, frame; FRAME_PTR f; - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { frame = XCAR (tail); - if (!GC_FRAMEP (frame)) + if (!FRAMEP (frame)) continue; f = XFRAME (frame); if (!FRAME_WINDOW_P (f)) @@ -2591,14 +2592,13 @@ DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_ void syms_of_w32menu () { - globals_of_w32menu (); + globals_of_w32menu (); staticpro (&menu_items); menu_items = Qnil; current_popup_menu = NULL; - Qdebug_on_next_call = intern ("debug-on-next-call"); - staticpro (&Qdebug_on_next_call); + DEFSYM (Qdebug_on_next_call, "debug-on-next-call"); defsubr (&Sx_popup_menu); defsubr (&Smenu_or_popup_active_p); diff --git a/src/w32proc.c b/src/w32proc.c index a14a8ee384c..7ce01aa3e50 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -55,6 +55,7 @@ extern BOOL WINAPI IsValidLocale(LCID, DWORD); #endif #include "lisp.h" +#include "character.h" #include "w32.h" #include "w32heap.h" #include "systime.h" @@ -2258,10 +2259,8 @@ If successful, the new layout id is returned, otherwise nil. */) syms_of_ntproc () { - Qhigh = intern ("high"); - Qlow = intern ("low"); - staticpro (&Qhigh); - staticpro (&Qlow); + DEFSYM (Qhigh, "high"); + DEFSYM (Qlow, "low"); #ifdef HAVE_SOCKETS defsubr (&Sw32_has_winsock); diff --git a/src/w32select.c b/src/w32select.c index 0690204ad72..d620206aa13 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -82,6 +82,7 @@ Boston, MA 02110-1301, USA. */ #include "keyboard.h" /* cmd_error_internal() */ #include "charset.h" #include "coding.h" +#include "character.h" #include "composite.h" @@ -100,6 +101,9 @@ static void setup_config (void); static BOOL WINAPI enum_locale_callback (/*const*/ char* loc_string); static UINT cp_from_locale (LCID lcid, UINT format); static Lisp_Object coding_from_cp (UINT codepage); +static Lisp_Object validate_coding_system (Lisp_Object coding_system); +static void setup_windows_coding_system (Lisp_Object coding_system, + struct coding_system * coding); /* A remnant from X11: Symbol for the CLIPBORD selection type. Other @@ -213,63 +217,36 @@ convert_to_handle_as_ascii (void) static HGLOBAL convert_to_handle_as_coded (Lisp_Object coding_system) { - HGLOBAL htext = NULL, htext2; - int nbytes; - unsigned char *src; + HGLOBAL htext; unsigned char *dst = NULL; - int bufsize; struct coding_system coding; - Lisp_Object string = Qnil; ONTRACE (fprintf (stderr, "convert_to_handle_as_coded: %s\n", SDATA (SYMBOL_NAME (coding_system)))); - setup_coding_system (Fcheck_coding_system (coding_system), &coding); - coding.src_multibyte = 1; - coding.dst_multibyte = 0; - /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in - encode_coding_iso2022 trying to dereference a null pointer. */ - coding.composing = COMPOSITION_DISABLED; - if (coding.type == coding_type_iso2022) - coding.flags |= CODING_FLAG_ISO_SAFE; - coding.mode |= CODING_MODE_LAST_BLOCK; - /* Force DOS line-ends. */ - coding.eol_type = CODING_EOL_CRLF; - - if (SYMBOLP (coding.pre_write_conversion) - && !NILP (Ffboundp (coding.pre_write_conversion))) - string = run_pre_post_conversion_on_str (current_text, &coding, 1); - else - string = current_text; - - nbytes = SBYTES (string); - src = SDATA (string); + setup_windows_coding_system (coding_system, &coding); + coding.dst_bytes = SBYTES(current_text) * 2; + coding.destination = (unsigned char *) xmalloc (coding.dst_bytes); + encode_coding_object (&coding, current_text, 0, 0, + SCHARS (current_text), SBYTES (current_text), Qnil); - bufsize = encoding_buffer_size (&coding, nbytes) +2; - htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize); + htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, coding.produced +2); if (htext != NULL) dst = (unsigned char *) GlobalLock (htext); if (dst != NULL) { - encode_coding (&coding, src, dst, nbytes, bufsize-2); + memcpy (dst, coding.destination, coding.produced); /* Add the string terminator. Add two NULs in case we are producing Unicode here. */ dst[coding.produced] = dst[coding.produced+1] = '\0'; - } - - if (dst != NULL) - GlobalUnlock (htext); - if (htext != NULL) - { - /* Shrink data block to actual size. */ - htext2 = GlobalReAlloc (htext, coding.produced+2, - GMEM_MOVEABLE | GMEM_DDESHARE); - if (htext2 != NULL) htext = htext2; + GlobalUnlock (htext); } + xfree (coding.destination); + return htext; } @@ -518,17 +495,26 @@ setup_config (void) const char *cp; char *end; int slen; - Lisp_Object new_coding_system; + Lisp_Object coding_system; + Lisp_Object dos_coding_system; CHECK_SYMBOL (Vselection_coding_system); - /* Check if we have it cached */ - new_coding_system = NILP (Vnext_selection_coding_system) ? + coding_system = NILP (Vnext_selection_coding_system) ? Vselection_coding_system : Vnext_selection_coding_system; + + dos_coding_system = validate_coding_system (coding_system); + if (NILP (dos_coding_system)) + Fsignal (Qerror, + list2 (build_string ("Coding system is invalid or doesn't have " + "an eol variant for dos line ends"), + coding_system)); + + /* Check if we have it cached */ if (!NILP (cfg_coding_system) - && EQ (cfg_coding_system, new_coding_system)) + && EQ (cfg_coding_system, dos_coding_system)) return; - cfg_coding_system = new_coding_system; + cfg_coding_system = dos_coding_system; /* Set some sensible fallbacks */ cfg_codepage = ANSICP; @@ -637,12 +623,61 @@ coding_from_cp (UINT codepage) char buffer[30]; sprintf (buffer, "cp%d-dos", (int) codepage); return intern (buffer); - /* We don't need to check that this coding system exists right here, - because that is done when the coding system is actually - instantiated, i.e. it is passed through Fcheck_coding_system() - there. */ + /* We don't need to check that this coding system actually exists + right here, because that is done later for all coding systems + used, regardless of where they originate. */ } +static Lisp_Object +validate_coding_system (Lisp_Object coding_system) +{ + Lisp_Object eol_type; + + /* Make sure the input is valid. */ + if (NILP (Fcoding_system_p (coding_system))) + return Qnil; + + /* Make sure we use a DOS coding system as mandated by the system + specs. */ + eol_type = Fcoding_system_eol_type (coding_system); + + /* Already a DOS coding system? */ + if (EQ (eol_type, make_number (1))) + return coding_system; + + /* Get EOL_TYPE vector of the base of CODING_SYSTEM. */ + if (!VECTORP (eol_type)) + { + eol_type = Fcoding_system_eol_type (Fcoding_system_base (coding_system)); + if (!VECTORP (eol_type)) + return Qnil; + } + + return AREF (eol_type, 1); +} + +static void +setup_windows_coding_system (Lisp_Object coding_system, + struct coding_system * coding) +{ + memset (coding, 0, sizeof (*coding)); + setup_coding_system (coding_system, coding); + + /* Unset CODING_ANNOTATE_COMPOSITION_MASK. Previous code had + comments about crashes in encode_coding_iso2022 trying to + dereference a null pointer when composition was on. Selection + data should not contain any composition sequence on Windows. + + CODING_ANNOTATION_MASK also includes + CODING_ANNOTATE_DIRECTION_MASK and CODING_ANNOTATE_CHARSET_MASK, + which both apply to ISO6429 only. We don't know if these really + need to be unset on Windows, but it probably doesn't hurt + either. */ + coding->mode &= ~CODING_ANNOTATION_MASK; + coding->mode |= CODING_MODE_LAST_BLOCK | CODING_MODE_SAFE_ENCODING; +} + + DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, Sw32_set_clipboard_data, 1, 2, 0, @@ -847,10 +882,9 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, if (require_decoding) { - int bufsize; - unsigned char *buf; struct coding_system coding; Lisp_Object coding_system = Qnil; + Lisp_Object dos_coding_system; /* `next-selection-coding-system' should override everything, even when the locale passed by the system disagrees. The @@ -912,27 +946,16 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, coding_system = Vselection_coding_system; Vnext_selection_coding_system = Qnil; - setup_coding_system (Fcheck_coding_system (coding_system), &coding); - coding.src_multibyte = 0; - coding.dst_multibyte = 1; - coding.mode |= CODING_MODE_LAST_BLOCK; - /* We explicitely disable composition handling because - selection data should not contain any composition - sequence. */ - coding.composing = COMPOSITION_DISABLED; - /* Force DOS line-ends. */ - coding.eol_type = CODING_EOL_CRLF; - - bufsize = decoding_buffer_size (&coding, nbytes); - buf = (unsigned char *) xmalloc (bufsize); - decode_coding (&coding, src, buf, nbytes, bufsize); - Vlast_coding_system_used = coding.symbol; - ret = make_string_from_bytes ((char *) buf, - coding.produced_char, coding.produced); - xfree (buf); - if (SYMBOLP (coding.post_read_conversion) - && !NILP (Ffboundp (coding.post_read_conversion))) - ret = run_pre_post_conversion_on_str (ret, &coding, 0); + dos_coding_system = validate_coding_system (coding_system); + if (!NILP (dos_coding_system)) + { + setup_windows_coding_system (dos_coding_system, &coding); + coding.source = src; + decode_coding_object (&coding, Qnil, 0, 0, nbytes, nbytes, Qt); + ret = coding.dst_object; + + Vlast_coding_system_used = CODING_ID_NAME (coding.id); + } } else { @@ -1017,10 +1040,11 @@ and t is the same as `SECONDARY'. */) { Lisp_Object val = Qnil; + setup_config (); + if (OpenClipboard (NULL)) { UINT format = 0; - setup_config (); while ((format = EnumClipboardFormats (format))) /* Check CF_TEXT in addition to cfg_clipboard_type, because we can fall back on that if CF_UNICODETEXT is @@ -1066,13 +1090,13 @@ next communication only. After the communication, this variable is set to nil. */); Vnext_selection_coding_system = Qnil; - QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD); + DEFSYM (QCLIPBOARD, "CLIPBOARD"); cfg_coding_system = Qnil; staticpro (&cfg_coding_system); current_text = Qnil; staticpro (¤t_text); current_coding_system = Qnil; staticpro (¤t_coding_system); - QUNICODE = intern ("utf-16le-dos"); staticpro (&QUNICODE); + DEFSYM (QUNICODE, "utf-16le-dos"); QANSICP = Qnil; staticpro (&QANSICP); QOEMCP = Qnil; staticpro (&QOEMCP); } diff --git a/src/w32term.c b/src/w32term.c index 2c22399bc1b..b489657361c 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -25,25 +25,21 @@ Boston, MA 02110-1301, USA. */ #include <stdio.h> #include <stdlib.h> #include "lisp.h" -#include "charset.h" #include "blockinput.h" - -#include "w32heap.h" #include "w32term.h" -#include "w32bdf.h" -#include <shellapi.h> #include "systty.h" #include "systime.h" -#include "atimer.h" -#include "keymap.h" #include <ctype.h> #include <errno.h> #include <setjmp.h> #include <sys/stat.h> -#include "keyboard.h" +#include "charset.h" +#include "character.h" +#include "coding.h" +#include "ccl.h" #include "frame.h" #include "dispextern.h" #include "fontset.h" @@ -54,9 +50,19 @@ Boston, MA 02110-1301, USA. */ #include "disptab.h" #include "buffer.h" #include "window.h" +#include "keyboard.h" #include "intervals.h" -#include "composite.h" -#include "coding.h" +#include "process.h" +#include "atimer.h" +#include "keymap.h" + +#include "w32heap.h" +#include "w32bdf.h" +#include <shellapi.h> + +#ifdef USE_FONT_BACKEND +#include "font.h" +#endif /* USE_FONT_BACKEND */ /* Fringe bitmaps. */ @@ -119,6 +125,31 @@ struct w32_display_info *x_display_list; FONT-LIST-CACHE records previous values returned by x-list-fonts. */ Lisp_Object w32_display_name_list; + +#ifndef GLYPHSET +/* Pre Windows 2000, this was not available, but define it here so + that Emacs compiled on such a platform will run on newer versions. */ + +typedef struct tagWCRANGE +{ + WCHAR wcLow; + USHORT cGlyphs; +} WCRANGE; + +typedef struct tagGLYPHSET +{ + DWORD cbThis; + DWORD flAccel; + DWORD cGlyphsSupported; + DWORD cRanges; + WCRANGE ranges[1]; +} GLYPHSET; + +#endif + +/* Dynamic linking to GetFontUnicodeRanges (not available on 95, 98, ME). */ +DWORD (PASCAL *pfnGetFontUnicodeRanges) (HDC device, GLYPHSET *ranges); + /* Frame being updated by update_frame. This is declared in term.c. This is set by update_begin and looked at by all the w32 functions. It is zero while not inside an update. @@ -867,7 +898,8 @@ w32_reset_terminal_modes (struct terminal *term) /* Function prototypes of this page. */ XCharStruct *w32_per_char_metric P_ ((XFontStruct *, wchar_t *, int)); -static int w32_encode_char P_ ((int, wchar_t *, struct font_info *, int *)); +static int w32_encode_char P_ ((int, wchar_t *, struct font_info *, + struct charset *, int *)); /* Get metrics of character CHAR2B in FONT. Value is always non-null. @@ -992,8 +1024,8 @@ w32_native_per_char_metric (font, char2b, font_type, pcm) if (retval) { - pcm->width = sz.cx - font->tm.tmOverhang; - pcm->rbearing = sz.cx; + pcm->width = sz.cx; + pcm->rbearing = sz.cx + font->tm.tmOverhang; pcm->lbearing = 0; pcm->ascent = FONT_BASE (font); pcm->descent = FONT_DESCENT (font); @@ -1074,9 +1106,9 @@ w32_cache_char_metrics (font) { /* Use the font width and height as max bounds, as not all BDF fonts contain the letter 'x'. */ - font->max_bounds.width = FONT_MAX_WIDTH (font); + font->max_bounds.width = FONT_WIDTH (font); font->max_bounds.lbearing = -font->bdf->llx; - font->max_bounds.rbearing = FONT_MAX_WIDTH (font) - font->bdf->urx; + font->max_bounds.rbearing = FONT_WIDTH (font) - font->bdf->urx; font->max_bounds.ascent = FONT_BASE (font); font->max_bounds.descent = FONT_DESCENT (font); } @@ -1132,13 +1164,13 @@ w32_use_unicode_for_codepage (codepage) the two-byte form of C. Encoding is returned in *CHAR2B. */ static int /* enum w32_char_font_type */ -w32_encode_char (c, char2b, font_info, two_byte_p) +w32_encode_char (c, char2b, font_info, charset, two_byte_p) int c; wchar_t *char2b; struct font_info *font_info; + struct charset *charset; int * two_byte_p; { - int charset = CHAR_CHARSET (c); int codepage; int unicode_p = 0; int internal_two_byte_p = 0; @@ -1146,29 +1178,39 @@ w32_encode_char (c, char2b, font_info, two_byte_p) XFontStruct *font = font_info->font; internal_two_byte_p = w32_font_is_double_byte (font); + codepage = font_info->codepage; + + /* If font can output unicode, use the original unicode character. */ + if ( font && !font->bdf && w32_use_unicode_for_codepage (codepage) + && c >= 0x100) + { + *char2b = c; + unicode_p = 1; + internal_two_byte_p = 1; + } /* FONT_INFO may define a scheme by which to encode byte1 and byte2. This may be either a program in a special encoder language or a fixed encoding. */ - if (font_info->font_encoder) + else if (font_info->font_encoder) { /* It's a program. */ struct ccl_program *ccl = font_info->font_encoder; if (CHARSET_DIMENSION (charset) == 1) { - ccl->reg[0] = charset; + ccl->reg[0] = CHARSET_ID (charset); ccl->reg[1] = XCHAR2B_BYTE2 (char2b); ccl->reg[2] = -1; } else { - ccl->reg[0] = charset; + ccl->reg[0] = CHARSET_ID (charset); ccl->reg[1] = XCHAR2B_BYTE1 (char2b); ccl->reg[2] = XCHAR2B_BYTE2 (char2b); } - ccl_driver (ccl, NULL, NULL, 0, 0, NULL); + ccl_driver (ccl, NULL, NULL, 0, 0, Qnil); /* We assume that MSBs are appropriately set/reset by CCL program. */ @@ -1177,50 +1219,26 @@ w32_encode_char (c, char2b, font_info, two_byte_p) else STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]); } - else if (font_info->encoding[charset]) + else if (font_info->encoding_type) { /* Fixed encoding scheme. See fontset.h for the meaning of the encoding numbers. */ - int enc = font_info->encoding[charset]; + unsigned char enc = font_info->encoding_type; if ((enc == 1 || enc == 2) && CHARSET_DIMENSION (charset) == 2) STORE_XCHAR2B (char2b, XCHAR2B_BYTE1 (char2b) | 0x80, XCHAR2B_BYTE2 (char2b)); - if (enc == 1 || enc == 3 - || (enc == 4 && CHARSET_DIMENSION (charset) == 1)) + if (enc == 1 || enc == 3 || (enc == 4 && CHARSET_DIMENSION (charset) == 1)) STORE_XCHAR2B (char2b, XCHAR2B_BYTE1 (char2b), XCHAR2B_BYTE2 (char2b) | 0x80); else if (enc == 4) { - int sjis1, sjis2; + int code = (int) (*char2b); - ENCODE_SJIS (XCHAR2B_BYTE1 (char2b), XCHAR2B_BYTE2 (char2b), - sjis1, sjis2); - STORE_XCHAR2B (char2b, sjis1, sjis2); + JIS_TO_SJIS (code); + STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); } } - codepage = font_info->codepage; - - /* If charset is not ASCII or Latin-1, may need to move it into - Unicode space. */ - if ( font && !font->bdf && w32_use_unicode_for_codepage (codepage) - && charset != CHARSET_ASCII && charset != charset_latin_iso8859_1 - && charset != CHARSET_8_BIT_CONTROL && charset != CHARSET_8_BIT_GRAPHIC) - { - char temp[3]; - temp[0] = XCHAR2B_BYTE1 (char2b); - temp[1] = XCHAR2B_BYTE2 (char2b); - temp[2] = '\0'; - if (codepage != CP_UNICODE) - { - if (temp[0]) - MultiByteToWideChar (codepage, 0, temp, 2, char2b, 1); - else - MultiByteToWideChar (codepage, 0, temp+1, 1, char2b, 1); - } - unicode_p = 1; - internal_two_byte_p = 1; - } if (two_byte_p) *two_byte_p = internal_two_byte_p; @@ -1238,6 +1256,207 @@ w32_encode_char (c, char2b, font_info, two_byte_p) } +/* Return a char-table whose elements are t if the font FONT_INFO + contains a glyph for the corresponding character, and nil if not. + + Fixme: For the moment, this function works only for fonts whose + glyph encoding is the same as Unicode (e.g. ISO10646-1 fonts). */ + +Lisp_Object +x_get_font_repertory (f, font_info) + FRAME_PTR f; + struct font_info *font_info; +{ + XFontStruct *font = (XFontStruct *) font_info->font; + Lisp_Object table; + int min_byte1, max_byte1, min_byte2, max_byte2; + int c; + struct charset *charset = CHARSET_FROM_ID (font_info->charset); + int offset = CHARSET_OFFSET (charset); + + table = Fmake_char_table (Qnil, Qnil); + + if (!font->bdf && pfnGetFontUnicodeRanges) + { + GLYPHSET *glyphset; + DWORD glyphset_size; + HDC display = get_frame_dc (f); + HFONT prev_font; + int i; + + prev_font = SelectObject (display, font->hfont); + + /* First call GetFontUnicodeRanges to find out how big a structure + we need. */ + glyphset_size = pfnGetFontUnicodeRanges (display, NULL); + if (glyphset_size) + { + glyphset = (GLYPHSET *) alloca (glyphset_size); + glyphset->cbThis = glyphset_size; + + /* Now call it again to get the ranges. */ + glyphset_size = pfnGetFontUnicodeRanges (display, glyphset); + + if (glyphset_size) + { + /* Store the ranges in TABLE. */ + for (i = 0; i < glyphset->cRanges; i++) + { + int from = glyphset->ranges[i].wcLow; + int to = from + glyphset->ranges[i].cGlyphs - 1; + char_table_set_range (table, from, to, Qt); + } + } + } + + SelectObject (display, prev_font); + release_frame_dc (f, display); + + /* If we got the information we wanted above, then return it. */ + if (glyphset_size) + return table; + } + +#if 0 /* TODO: Convert to work on Windows so BDF and older platforms work. */ + /* When GetFontUnicodeRanges is not available or does not work, + work it out manually. */ + min_byte1 = font->min_byte1; + max_byte1 = font->max_byte1; + min_byte2 = font->min_char_or_byte2; + max_byte2 = font->max_char_or_byte2; + if (min_byte1 == 0 && max_byte1 == 0) + { + if (! font->per_char || font->all_chars_exist == True) + { + if (offset >= 0) + char_table_set_range (table, offset + min_byte2, + offset + max_byte2, Qt); + else + for (; min_byte2 <= max_byte2; min_byte2++) + { + c = DECODE_CHAR (charset, min_byte2); + CHAR_TABLE_SET (table, c, Qt); + } + } + else + { + XCharStruct *pcm = font->per_char; + int from = -1; + int i; + + for (i = min_byte2; i <= max_byte2; i++, pcm++) + { + if (pcm->width == 0 && pcm->rbearing == pcm->lbearing) + { + if (from >= 0) + { + if (offset >= 0) + char_table_set_range (table, offset + from, + offset + i - 1, Qt); + else + for (; from < i; from++) + { + c = DECODE_CHAR (charset, from); + CHAR_TABLE_SET (table, c, Qt); + } + from = -1; + } + } + else if (from < 0) + from = i; + } + if (from >= 0) + { + if (offset >= 0) + char_table_set_range (table, offset + from, offset + i - 1, + Qt); + else + for (; from < i; from++) + { + c = DECODE_CHAR (charset, from); + CHAR_TABLE_SET (table, c, Qt); + } + } + } + } + else + { + if (! font->per_char || font->all_chars_exist == True) + { + int i, j; + + if (offset >= 0) + for (i = min_byte1; i <= max_byte1; i++) + char_table_set_range + (table, offset + ((i << 8) | min_byte2), + offset + ((i << 8) | max_byte2), Qt); + else + for (i = min_byte1; i <= max_byte1; i++) + for (j = min_byte2; j <= max_byte2; j++) + { + unsiged code = (i << 8) | j; + c = DECODE_CHAR (charset, code); + CHAR_TABLE_SET (table, c, Qt); + } + } + else + { + XCharStruct *pcm = font->per_char; + int i; + + for (i = min_byte1; i <= max_byte1; i++) + { + int from = -1; + int j; + + for (j = min_byte2; j <= max_byte2; j++, pcm++) + { + if (pcm->width == 0 && pcm->rbearing == pcm->lbearing) + { + if (from >= 0) + { + if (offset >= 0) + char_table_set_range + (table, offset + ((i << 8) | from), + offset + ((i << 8) | (j - 1)), Qt); + else + { + for (; from < j; from++) + { + unsigned code = (i << 8) | from; + c = ENCODE_CHAR (charset, code); + CHAR_TABLE_SET (table, c, Qt); + } + } + from = -1; + } + } + else if (from < 0) + from = j; + } + if (from >= 0) + { + if (offset >= 0) + char_table_set_range + (table, offset + ((i << 8) | from), + offset + ((i << 8) | (j - 1)), Qt); + else + { + for (; from < j; from++) + { + unsigned code = (i << 8) | from; + c = DECODE_CHAR (charset, code); + CHAR_TABLE_SET (table, c, Qt); + } + } + } + } + } + } +#endif + return table; +} + /*********************************************************************** Glyph display @@ -1367,15 +1586,20 @@ x_set_mouse_face_gc (s) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch); + face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); else - face_id = FACE_FOR_CHAR (s->f, face, 0); + face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); s->face = FACE_FROM_ID (s->f, face_id); PREPARE_FACE_FOR_DISPLAY (s->f, s->face); /* If font in this face is same as S->font, use it. */ if (s->font == s->face->font) s->gc = s->face->gc; +#ifdef USE_FONT_BACKEND + else if (enable_font_backend) + /* No need of setting a font for s->gc. */ + s->gc = s->face->gc; +#endif /* USE_FONT_BACKEND */ else { /* Otherwise construct scratch_cursor_gc with values from FACE @@ -1469,11 +1693,68 @@ static INLINE void x_set_glyph_string_clipping (s) struct glyph_string *s; { - RECT r; - get_glyph_string_clip_rect (s, &r); - w32_set_clip_rectangle (s->hdc, &r); +#ifdef USE_FONT_BACKEND + RECT *r = s->clip; +#else + RECT r[2]; +#endif + int n = get_glyph_string_clip_rects (s, r, 2); + + if (n == 1) + w32_set_clip_rectangle (s->hdc, r); + else if (n > 1) + { + HRGN full_clip, clip1, clip2; + clip1 = CreateRectRgnIndirect (r); + clip2 = CreateRectRgnIndirect (r + 1); + if (CombineRgn (full_clip, clip1, clip2, RGN_OR) != ERROR) + { + SelectClipRgn (s->hdc, full_clip); + } + DeleteObject (clip1); + DeleteObject (clip2); + DeleteObject (full_clip); + } +#ifdef USE_FONT_BACKEND + s->num_clips = n; +#endif /* USE_FONT_BACKEND */ } +/* Set SRC's clipping for output of glyph string DST. This is called + when we are drawing DST's left_overhang or right_overhang only in + the area of SRC. */ + +static void +x_set_glyph_string_clipping_exactly (src, dst) + struct glyph_string *src, *dst; +{ + RECT r; + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + r.left = src->x; + r.right = r.left + src->width; + r.top = src->y; + r.bottom = r.top + src->height; + dst->clip[0] = r; + dst->num_clips = 1; + } + else + { +#endif /* USE_FONT_BACKEND */ + struct glyph_string *clip_head = src->clip_head; + struct glyph_string *clip_tail = src->clip_tail; + + /* This foces clipping just this glyph string. */ + src->clip_head = src->clip_tail = src; + get_glyph_string_clip_rect (src, &r); + src->clip_head = clip_head, src->clip_tail = clip_tail; +#ifdef USE_FONT_BACKEND + } +#endif /* USE_FONT_BACKEND */ + w32_set_clip_rectangle (dst->hdc, &r); +} /* RIF: Compute left and right overhang of glyph string S. If S is a glyph @@ -1618,6 +1899,26 @@ x_draw_glyph_string_foreground (s) x += g->pixel_width; } } +#ifdef USE_FONT_BACKEND + else if (enable_font_backend) + { + int boff = s->font_info->baseline_offset; + struct font *font = (struct font *) s->font_info; + int y; + + if (s->font_info->vertical_centering) + boff = VCENTER_BASELINE_OFFSET (s->font, s->f) - boff; + + y = s->ybase - boff; + if (s->for_overlaps + || (s->background_filled_p && s->hl != DRAW_CURSOR)) + font->driver->draw (s, 0, s->nchars, x, y, 0); + else + font->driver->draw (s, 0, s->nchars, x, y, 1); + if (s->face->overstrike) + font->driver->draw (s, 0, s->nchars, x + 1, y, 0); + } +#endif /* USE_FONT_BACKEND */ else { char *char1b = (char *) s->char2b; @@ -1654,12 +1955,12 @@ static void x_draw_composite_glyph_string_foreground (s) struct glyph_string *s; { - int i, x; + int i, j, x; HFONT old_font; /* If first glyph of S has a left box line, start drawing the text of S to the right of that box line. */ - if (s->face->box != FACE_NO_BOX + if (s->face && s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) x = s->x + eabs (s->face->box_line_width); else @@ -1686,18 +1987,76 @@ x_draw_composite_glyph_string_foreground (s) w32_draw_rectangle (s->hdc, s->gc, x, s->y, s->width - 1, s->height - 1); } - else +#ifdef USE_FONT_BACKEND + else if (enable_font_backend) { - for (i = 0; i < s->nchars; i++, ++s->gidx) + struct font *font = (struct font *) s->font_info; + int y = s->ybase; + int width = 0; + + if (s->cmp->method == COMPOSITION_WITH_GLYPH_STRING) { - w32_text_out (s, x + s->cmp->offsets[s->gidx * 2], - s->ybase - s->cmp->offsets[s->gidx * 2 + 1], - s->char2b + i, 1); - if (s->face->overstrike) - w32_text_out (s, x + s->cmp->offsets[s->gidx * 2] + 1, - s->ybase - s->cmp->offsets[s->gidx * 2 + 1], - s->char2b + i, 1); + Lisp_Object gstring = AREF (XHASH_TABLE (composition_hash_table) + ->key_and_value, + s->cmp->hash_index * 2); + int from; + + for (i = from = 0; i < s->nchars; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring, i); + Lisp_Object adjustment = LGLYPH_ADJUSTMENT (g); + int xoff, yoff, wadjust; + + if (! VECTORP (adjustment)) + { + width += LGLYPH_WIDTH (g); + continue; + } + if (from < i) + { + font->driver->draw (s, from, i, x, y, 0); + x += width; + } + xoff = XINT (AREF (adjustment, 0)); + yoff = XINT (AREF (adjustment, 1)); + wadjust = XINT (AREF (adjustment, 2)); + + font->driver->draw (s, i, i + 1, x + xoff, y + yoff, 0); + x += wadjust; + from = i + 1; + width = 0; + } + if (from < i) + font->driver->draw (s, from, i, x, y, 0); } + else + { + for (i = 0, j = s->gidx; i < s->nchars; i++, j++) + if (COMPOSITION_GLYPH (s->cmp, j) != '\t') + { + int xx = x + s->cmp->offsets[j * 2]; + int yy = y - s->cmp->offsets[j * 2 + 1]; + + font->driver->draw (s, j, j + 1, xx, yy, 0); + if (s->face->overstrike) + font->driver->draw (s, j, j + 1, xx + 1, yy, 0); + } + } + } +#endif /* USE_FONT_BACKEND */ + else + { + for (i = 0, j = s->gidx; i < s->nchars; i++, j++) + if (s->face) + { + w32_text_out (s, x + s->cmp->offsets[j * 2], + s->ybase - s->cmp->offsets[j * 2 + 1], + s->char2b + j, 1); + if (s->face->overstrike) + w32_text_out (s, x + s->cmp->offsets[j * 2] + 1, + s->ybase - s->cmp->offsets[j + 1], + s->char2b + j, 1); + } } if (s->font && s->font->hfont) @@ -2499,10 +2858,19 @@ x_draw_glyph_string (s) This makes S->next use XDrawString instead of XDrawImageString. */ if (s->next && s->right_overhang && !s->for_overlaps) { - xassert (s->next->img == NULL); - x_set_glyph_string_gc (s->next); - x_set_glyph_string_clipping (s->next); - x_draw_glyph_string_background (s->next, 1); + int width; + struct glyph_string *next; + for (width = 0, next = s->next; next; + width += next->width, next = next->next) + if (next->first_glyph->type != IMAGE_GLYPH) + { + x_set_glyph_string_gc (next); + x_set_glyph_string_clipping (next); + x_draw_glyph_string_background (next, 1); +#ifdef USE_FONT_BACKEND + next->num_clips = 0; +#endif /* USE_FONT_BACKEND */ + } } /* Set up S->gc, set clipping and draw S. */ @@ -2522,6 +2890,12 @@ x_draw_glyph_string (s) x_set_glyph_string_clipping (s); relief_drawn_p = 1; } + else if ((s->prev && s->prev->hl != s->hl && s->left_overhang) + || (s->next && s->next->hl != s->hl && s->right_overhang)) + /* We must clip just this glyph. left_overhang part has already + drawn when s->prev was drawn, and right_overhang part will be + drawn later when s->next is drawn. */ + x_set_glyph_string_clipping_exactly (s, s); else x_set_glyph_string_clipping (s); @@ -2561,41 +2935,64 @@ x_draw_glyph_string (s) if (s->face->underline_p && (s->font->bdf || !s->font->tm.tmUnderlined)) { - unsigned long h = 1; - unsigned long dy = 0; + unsigned long h; + int y; + /* Get the underline thickness. Default is 1 pixel. */ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + /* In the future, we must use information of font. */ + h = 1; + else +#endif /* USE_FONT_BACKEND */ + h = 1; - if (x_underline_at_descent_line) - dy = s->height - h; - else +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + if (s->face->font) + /* In the future, we must use information of font. */ + y = s->ybase + (s->face->font->max_bounds.descent + 1) / 2; + else + y = s->y + s->height - h; + } + else +#endif { - /* TODO: Use font information for positioning and thickness of - underline. See OUTLINETEXTMETRIC, and xterm.c. Note: If - you make this work, don't forget to change the doc string of - x-use-underline-position-properties below. */ - dy = s->height - h; + y = s->y + s->height - h; + /* TODO: Use font information for positioning and + thickness of underline. See OUTLINETEXTMETRIC, + and xterm.c. Note: If you make this work, + don't forget to change the doc string of + x-use-underline_color-position-properties + below. */ +#if 0 + if (!x_underline_at_descent_line) + { + ... + } +#endif } if (s->face->underline_defaulted_p) { w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x, - s->y + dy, s->background_width, 1); + y, s->background_width, 1); } else { w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x, - s->y + dy, s->background_width, 1); + y, s->background_width, 1); } } - /* Draw overline. */ if (s->face->overline_p) { unsigned long dy = 0, h = 1; if (s->face->overline_color_defaulted_p) - { - w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x, - s->y + dy, s->background_width, h); - } + { + w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x, + s->y + dy, s->background_width, h); + } else { w32_fill_area (s->f, s->hdc, s->face->overline_color, s->x, @@ -2622,13 +3019,70 @@ x_draw_glyph_string (s) } } - /* Draw relief. */ + /* Draw relief if not yet drawn. */ if (!relief_drawn_p && s->face->box != FACE_NO_BOX) x_draw_glyph_string_box (s); + + if (s->prev) + { + struct glyph_string *prev; + + for (prev = s->prev; prev; prev = prev->prev) + if (prev->hl != s->hl + && prev->x + prev->width + prev->right_overhang > s->x) + { + /* As prev was drawn while clipped to its own area, we + must draw the right_overhang part using s->hl now. */ + enum draw_glyphs_face save = prev->hl; + + prev->hl = s->hl; + x_set_glyph_string_gc (prev); + x_set_glyph_string_clipping_exactly (s, prev); + if (prev->first_glyph->type == CHAR_GLYPH) + x_draw_glyph_string_foreground (prev); + else + x_draw_composite_glyph_string_foreground (prev); + w32_set_clip_rectangle (prev->hdc, NULL); + prev->hl = save; +#ifdef USE_FONT_BACKEND + prev->num_clips = 0; +#endif /* USE_FONT_BACKEND */ + } + } + + if (s->next) + { + struct glyph_string *next; + + for (next = s->next; next; next = next->next) + if (next->hl != s->hl + && next->x - next->left_overhang < s->x + s->width) + { + /* As next will be drawn while clipped to its own area, + we must draw the left_overhang part using s->hl now. */ + enum draw_glyphs_face save = next->hl; + + next->hl = s->hl; + x_set_glyph_string_gc (next); + x_set_glyph_string_clipping_exactly (s, next); + if (next->first_glyph->type == CHAR_GLYPH) + x_draw_glyph_string_foreground (next); + else + x_draw_composite_glyph_string_foreground (next); + w32_set_clip_rectangle (next->hdc, NULL); + next->hl = save; +#ifdef USE_FONT_BACKEND + next->num_clips = 0; +#endif /* USE_FONT_BACKEND */ + } + } } /* Reset clipping. */ w32_set_clip_rectangle (s->hdc, NULL); +#ifdef USE_FONT_BACKEND + s->num_clips = 0; +#endif /* USE_FONT_BACKEND */ } @@ -2904,9 +3358,9 @@ x_focus_changed (type, state, dpyinfo, frame, bufp) /* Don't stop displaying the initial startup message for a switch-frame event we don't need. */ - if (GC_NILP (Vterminal_frame) - && GC_CONSP (Vframe_list) - && !GC_NILP (XCDR (Vframe_list))) + if (NILP (Vterminal_frame) + && CONSP (Vframe_list) + && !NILP (XCDR (Vframe_list))) { bufp->kind = FOCUS_IN_EVENT; XSETFRAME (bufp->frame_or_window, frame); @@ -2992,7 +3446,7 @@ x_frame_rehighlight (dpyinfo) if (dpyinfo->w32_focus_frame) { dpyinfo->x_highlight_frame - = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame))) + = ((FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame))) ? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame)) : dpyinfo->w32_focus_frame); if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame)) @@ -3251,6 +3705,9 @@ note_mouse_movement (frame, msg) memcpy (&last_mouse_motion_event, msg, sizeof (last_mouse_motion_event)); XSETFRAME (last_mouse_motion_frame, frame); + if (!FRAME_X_OUTPUT (frame)) + return 0; + if (msg->hwnd != FRAME_W32_WINDOW (frame)) { frame->mouse_moved = 1; @@ -3458,15 +3915,13 @@ x_window_to_scroll_bar (window_id) { Lisp_Object tail; - for (tail = Vframe_list; - XGCTYPE (tail) == Lisp_Cons; - tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object frame, bar, condemned; frame = XCAR (tail); /* All elements of Vframe_list should be frames. */ - if (! GC_FRAMEP (frame)) + if (! FRAMEP (frame)) abort (); /* Scan this frame's scroll bar list for a scroll bar with the @@ -3475,9 +3930,9 @@ x_window_to_scroll_bar (window_id) for (bar = FRAME_SCROLL_BARS (XFRAME (frame)); /* This trick allows us to search both the ordinary and condemned scroll bar lists with one loop. */ - ! GC_NILP (bar) || (bar = condemned, + ! NILP (bar) || (bar = condemned, condemned = Qnil, - ! GC_NILP (bar)); + ! NILP (bar)); bar = XSCROLL_BAR (bar)->next) if (SCROLL_BAR_W32_WINDOW (XSCROLL_BAR (bar)) == window_id) return XSCROLL_BAR (bar); @@ -3967,7 +4422,7 @@ w32_scroll_bar_handle_click (bar, msg, emacs_event) W32Msg *msg; struct input_event *emacs_event; { - if (! GC_WINDOWP (bar->window)) + if (! WINDOWP (bar->window)) abort (); emacs_event->kind = SCROLL_BAR_CLICK_EVENT; @@ -4315,6 +4770,7 @@ w32_read_socket (sd, expected, hold_quit) } break; + case WM_UNICHAR: case WM_SYSCHAR: case WM_CHAR: f = x_window_to_frame (dpyinfo, msg.msg.hwnd); @@ -4331,95 +4787,15 @@ w32_read_socket (sd, expected, hold_quit) if (temp_index == sizeof temp_buffer / sizeof (short)) temp_index = 0; temp_buffer[temp_index++] = msg.msg.wParam; - - if (msg.msg.wParam < 128 && !dbcs_lead) - { - inev.kind = ASCII_KEYSTROKE_EVENT; - inev.code = msg.msg.wParam; - } - else if (msg.msg.wParam < 256) + if (msg.msg.message == WM_UNICHAR) { - wchar_t code; - inev.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; - - if (IsDBCSLeadByteEx(CP_ACP, (BYTE) msg.msg.wParam)) - { - dbcs_lead = (char) msg.msg.wParam; - inev.kind = NO_EVENT; - break; - } - else if (dbcs_lead) - { - char dbcs[2]; - dbcs[0] = dbcs_lead; - dbcs[1] = (char) msg.msg.wParam; - dbcs_lead = 0; - if (!MultiByteToWideChar(CP_ACP, 0, dbcs, 2, &code, 1)) - { - /* Garbage */ - DebPrint (("Invalid DBCS sequence: %d %d\n", - dbcs[0], dbcs[1])); - inev.kind = NO_EVENT; - break; - } - } - else - { - char single_byte = (char) msg.msg.wParam; - if (!MultiByteToWideChar(CP_ACP, 0, &single_byte, 1, - &code, 1)) - { - /* What to do with garbage? */ - DebPrint (("Invalid character: %d\n", single_byte)); - inev.kind = NO_EVENT; - break; - } - } - - /* Now process unicode input as per xterm.c */ - if (code < 0x80) - { - inev.kind = ASCII_KEYSTROKE_EVENT; - inev.code = code; - } - else if (code < 0xA0) - inev.code = MAKE_CHAR (CHARSET_8_BIT_CONTROL, code, 0); - else if (code < 0x100) - inev.code = MAKE_CHAR (charset_latin_iso8859_1, code, 0); - else - { - int c1, c2; - int charset_id; - - if (code < 0x2500) - { - charset_id = charset_mule_unicode_0100_24ff; - code -= 0x100; - } - else if (code < 0xE000) - { - charset_id = charset_mule_unicode_2500_33ff; - code -= 0x2500; - } - else - { - charset_id = charset_mule_unicode_e000_ffff; - code -= 0xE000; - } - - c1 = (code / 96) + 32; - c2 = (code % 96) + 32; - inev.code = MAKE_CHAR (charset_id, c1, c2); - } + inev.code = msg.msg.wParam; } else { - /* Windows shouldn't generate WM_CHAR events above 0xFF - in non-Unicode message handlers. */ - DebPrint (("Non-byte WM_CHAR: %d\n", msg.msg.wParam)); - inev.kind = NO_EVENT; - break; + inev.kind = ASCII_KEYSTROKE_EVENT; + inev.code = msg.msg.wParam; } inev.modifiers = msg.dwModifiers; XSETFRAME (inev.frame_or_window, f); @@ -5416,11 +5792,16 @@ x_new_font (f, fontname) register char *fontname; { struct font_info *fontp - = FS_LOAD_FONT (f, 0, fontname, -1); + = FS_LOAD_FONT (f, fontname); if (!fontp) return Qnil; + if (FRAME_FONT (f) == (XFontStruct *) (fontp->font)) + /* This font is already set in frame F. There's nothing more to + do. */ + return build_string (fontp->full_name); + FRAME_FONT (f) = (XFontStruct *) (fontp->font); FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset; FRAME_FONTSET (f) = -1; @@ -5454,39 +5835,113 @@ x_new_font (f, fontname) return build_string (fontp->full_name); } -/* Give frame F the fontset named FONTSETNAME as its default font, and - return the full name of that fontset. FONTSETNAME may be a wildcard - pattern; in that case, we choose some fontset that fits the pattern. - The return value shows which fontset we chose. */ +/* Give frame F the fontset named FONTSETNAME as its default fontset, + and return the full name of that fontset. FONTSETNAME may be a + wildcard pattern; in that case, we choose some fontset that fits + the pattern. FONTSETNAME may be a font name for ASCII characters; + in that case, we create a fontset from that font name. + + The return value shows which fontset we chose. + If FONTSETNAME specifies the default fontset, return Qt. + If an ASCII font in the specified fontset can't be loaded, return + Qnil. */ Lisp_Object x_new_fontset (f, fontsetname) struct frame *f; - char *fontsetname; + Lisp_Object fontsetname; { - int fontset = fs_query_fontset (build_string (fontsetname), 0); + int fontset = fs_query_fontset (fontsetname, 0); Lisp_Object result; - if (fontset < 0) - return Qnil; - - if (FRAME_FONTSET (f) == fontset) + if (fontset > 0 && FRAME_FONTSET(f) == fontset) /* This fontset is already set in frame F. There's nothing more to do. */ return fontset_name (fontset); + else if (fontset == 0) + /* The default fontset can't be the default font. */ + return Qt; - result = x_new_font (f, (SDATA (fontset_ascii (fontset)))); + if (fontset > 0) + result = x_new_font (f, (SDATA (fontset_ascii (fontset)))); + else + result = x_new_font (f, SDATA (fontsetname)); if (!STRINGP (result)) /* Can't load ASCII font. */ return Qnil; + if (fontset < 0) + fontset = new_fontset_from_font_name (result); + /* Since x_new_font doesn't update any fontset information, do it now. */ FRAME_FONTSET(f) = fontset; - return build_string (fontsetname); + return fontset_name (fontset); } +#ifdef USE_FONT_BACKEND +Lisp_Object +x_new_fontset2 (f, fontset, font_object) + struct frame *f; + int fontset; + Lisp_Object font_object; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + + if (FRAME_FONT_OBJECT (f) == font) + /* This font is already set in frame F. There's nothing more to + do. */ + return fontset_name (fontset); + + BLOCK_INPUT; + + FRAME_FONT_OBJECT (f) = font; + FRAME_FONT (f) = font->font.font; + FRAME_BASELINE_OFFSET (f) = font->font.baseline_offset; + FRAME_FONTSET (f) = fontset; + + FRAME_COLUMN_WIDTH (f) = font->font.average_width; + FRAME_SPACE_WIDTH (f) = font->font.space_width; + FRAME_LINE_HEIGHT (f) = font->font.height; + + compute_fringe_widths (f, 1); + + /* Compute the scroll bar width in character columns. */ + if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0) + { + int wid = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_COLS (f) + = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + wid - 1) / wid; + } + else + { + int wid = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid; + } + + /* Now make the frame display the given font. */ + if (FRAME_X_WINDOW (f) != 0) + { + /* Don't change the size of a tip frame; there's no point in + doing it because it's done in Fx_show_tip, and it leads to + problems because the tip frame has no widget. */ + if (NILP (tip_frame) || XFRAME (tip_frame) != f) + x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f)); + } + +#ifdef HAVE_X_I18N + if (FRAME_XIC (f) + && (FRAME_XIC_STYLE (f) & (XIMPreeditPosition | XIMStatusArea))) + xic_set_xfontset (f, SDATA (fontset_ascii (fontset))); +#endif + + UNBLOCK_INPUT; + + return fontset_name (fontset); +} +#endif /* USE_FONT_BACKEND */ + /*********************************************************************** TODO: W32 Input Methods @@ -6042,6 +6497,15 @@ x_free_frame_resources (f) BLOCK_INPUT; +#ifdef USE_FONT_BACKEND + /* We must free faces before destroying windows because some + font-driver (e.g. xft) access a window while finishing a + face. */ + if (enable_font_backend + && FRAME_FACE_CACHE (f)) + free_frame_faces (f); +#endif /* USE_FONT_BACKEND */ + if (FRAME_W32_WINDOW (f)) my_destroy_window (f, FRAME_W32_WINDOW (f)); @@ -6194,7 +6658,7 @@ x_font_min_bounds (font, w, h) * average and maximum width, and maximum height. */ *h = FONT_HEIGHT (font); - *w = FONT_WIDTH (font); + *w = FONT_AVG_WIDTH (font); } @@ -6677,13 +7141,22 @@ w32_initialize () AttachThreadInput (dwMainThreadId, dwWindowsThreadId, TRUE); #endif - /* Load system settings. */ + /* Dynamically link to optional system components. */ { UINT smoothing_type; BOOL smoothing_enabled; - /* If using proportional scroll bars, ensure handle is at least 5 pixels; - otherwise use the fixed height. */ + HANDLE gdi_lib = LoadLibrary ("gdi32.dll"); + +#define LOAD_PROC(lib, fn) pfn##fn = (void *) GetProcAddress (lib, #fn) + + LOAD_PROC (gdi_lib, GetFontUnicodeRanges); + +#undef LOAD_PROC + + FreeLibrary (gdi_lib); + + /* Ensure scrollbar handle is at least 5 pixels. */ vertical_scroll_bar_min_handle = 5; /* For either kind of scroll bar, take account of the arrows; these @@ -6724,8 +7197,7 @@ syms_of_w32term () staticpro (&last_mouse_scroll_bar); last_mouse_scroll_bar = Qnil; - staticpro (&Qvendor_specific_keysyms); - Qvendor_specific_keysyms = intern ("vendor-specific-keysyms"); + DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms"); DEFVAR_INT ("w32-num-mouse-buttons", &w32_num_mouse_buttons, diff --git a/src/w32term.h b/src/w32term.h index d331772dce9..75ff9f71e4a 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -28,15 +28,15 @@ Boston, MA 02110-1301, USA. */ #define WHITE_PIX_DEFAULT(f) PALETTERGB(255,255,255) #define FONT_WIDTH(f) \ - ((f)->bdf ? (f)->bdf->width : (f)->tm.tmAveCharWidth) + ((f)->bdf ? (f)->bdf->width : (f)->tm.tmMaxCharWidth) #define FONT_HEIGHT(f) \ ((f)->bdf ? (f)->bdf->height : (f)->tm.tmHeight) #define FONT_BASE(f) \ ((f)->bdf ? (f)->bdf->ury : (f)->tm.tmAscent) #define FONT_DESCENT(f) \ ((f)->bdf ? -((f)->bdf->lly) : (f)->tm.tmDescent) -#define FONT_MAX_WIDTH(f) \ - ((f)->bdf ? (f)->bdf->width : (f)->tm.tmMaxCharWidth) +#define FONT_AVG_WIDTH(f) \ + ((f)->bdf ? (f)->bdf->width : (f)->tm.tmAveCharWidth) #define CP_DEFAULT 1004 /* Special pseudo-codepages. */ @@ -263,6 +263,8 @@ extern Lisp_Object w32_list_fonts P_ ((struct frame *, Lisp_Object, int, int)); extern struct font_info *w32_get_font_info (), *w32_query_font (); extern void w32_cache_char_metrics (XFontStruct *font); extern void w32_find_ccl_program(); +extern Lisp_Object x_get_font_repertory P_ ((struct frame *, + struct font_info *)); #define PIX_TYPE COLORREF @@ -327,6 +329,10 @@ struct w32_output /* Default ASCII font of this frame. */ XFontStruct *font; +#ifdef USE_FONT_BACKEND + struct font *fontp; +#endif /* USE_FONT_BACKEND */ + /* The baseline offset of the default ASCII font. */ int baseline_offset; @@ -414,6 +420,10 @@ extern struct w32_output w32term_display; #define FRAME_FONTSET(f) ((f)->output_data.w32->fontset) #define FRAME_BASELINE_OFFSET(f) ((f)->output_data.w32->baseline_offset) +#ifdef USE_FONT_BACKEND +#define FRAME_FONT_OBJECT(f) ((f)->output_data.w32->fontp) +#endif /* USE_FONT_BACKEND */ + /* This gives the w32_display_info structure for the display F is on. */ #define FRAME_W32_DISPLAY_INFO(f) (&one_w32_display_info) #define FRAME_X_DISPLAY_INFO(f) (&one_w32_display_info) @@ -619,6 +629,12 @@ extern void w32_unload_font (); #define WM_APPCOMMAND 0x319 #define GET_APPCOMMAND_LPARAM(lParam) (HIWORD(lParam) & 0x7fff) #endif +#ifndef WM_UNICHAR +#define WM_UNICHAR 0x109 +#endif +#ifndef UNICODE_NOCHAR +#define UNICODE_NOCHAR 0xFFFF +#endif #define WM_EMACS_START (WM_USER + 1) #define WM_EMACS_KILL (WM_EMACS_START + 0) diff --git a/src/w32xfns.c b/src/w32xfns.c index 9d50676f921..8c87fde3ef9 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -192,6 +192,47 @@ get_next_msg (lpmsg, bWait) } nQueue--; + /* Consolidate WM_PAINT messages to optimise redrawing. */ + if (lpmsg->msg.message == WM_PAINT && nQueue) + { + int_msg * lpCur = lpHead; + int_msg * lpPrev = NULL; + int_msg * lpNext = NULL; + + while (lpCur && nQueue) + { + lpNext = lpCur->lpNext; + if (lpCur->w32msg.msg.message == WM_PAINT) + { + /* Remove this message from the queue. */ + if (lpPrev) + lpPrev->lpNext = lpNext; + else + lpHead = lpNext; + + if (lpCur == lpTail) + lpTail = lpPrev; + + /* Adjust clip rectangle to cover both. */ + if (!UnionRect (&(lpmsg->rect), &(lpmsg->rect), + &(lpCur->w32msg.rect))) + { + SetRectEmpty(&(lpmsg->rect)); + } + + myfree (lpCur); + + nQueue--; + + lpCur = lpNext; + } + else + { + lpPrev = lpCur; + lpCur = lpNext; + } + } + } bRet = TRUE; } diff --git a/src/window.c b/src/window.c index d0f351261e1..129a553f65d 100644 --- a/src/window.c +++ b/src/window.c @@ -3792,7 +3792,7 @@ displayed. */) window = call1 (Vsplit_window_preferred_function, window); else { - Lisp_Object upper, lower, other; + Lisp_Object upper, other; window = Fget_lru_window (frames, Qt); /* If the LRU window is tall enough, and either eligible for @@ -3831,11 +3831,11 @@ displayed. */) window = Fframe_selected_window (call0 (Vpop_up_frame_function)); /* If window appears above or below another, even out their heights. */ - other = upper = lower = Qnil; + other = upper = Qnil; if (!NILP (XWINDOW (window)->prev)) - other = upper = XWINDOW (window)->prev, lower = window; + other = upper = XWINDOW (window)->prev; if (!NILP (XWINDOW (window)->next)) - other = lower = XWINDOW (window)->next, upper = window; + other = XWINDOW (window)->next, upper = window; if (!NILP (other) && !NILP (Veven_window_heights) /* Check that OTHER and WINDOW are vertically arrayed. */ diff --git a/src/xdisp.c b/src/xdisp.c index c352c9355ae..8e24fbacb4e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -177,6 +177,7 @@ Boston, MA 02110-1301, USA. */ #include "termchar.h" #include "dispextern.h" #include "buffer.h" +#include "character.h" #include "charset.h" #include "indent.h" #include "commands.h" @@ -201,6 +202,12 @@ Boston, MA 02110-1301, USA. */ #include "macterm.h" #endif +#ifdef HAVE_WINDOW_SYSTEM +#ifdef USE_FONT_BACKEND +#include "font.h" +#endif /* USE_FONT_BACKEND */ +#endif /* HAVE_WINDOW_SYSTEM */ + #ifndef FRAME_X_OUTPUT #define FRAME_X_OUTPUT(f) ((f)->output_data.x) #endif @@ -744,6 +751,7 @@ static enum prop_handled handle_display_prop P_ ((struct it *)); static enum prop_handled handle_composition_prop P_ ((struct it *)); static enum prop_handled handle_overlay_change P_ ((struct it *)); static enum prop_handled handle_fontified_prop P_ ((struct it *)); +static enum prop_handled handle_auto_composed_prop P_ ((struct it *)); /* Properties handled by iterators. */ @@ -755,6 +763,7 @@ static struct props it_props[] = {&Qface, FACE_PROP_IDX, handle_face_prop}, {&Qdisplay, DISPLAY_PROP_IDX, handle_display_prop}, {&Qinvisible, INVISIBLE_PROP_IDX, handle_invisible_prop}, + {&Qauto_composed, AUTO_COMPOSED_PROP_IDX, handle_auto_composed_prop}, {&Qcomposition, COMPOSITION_PROP_IDX, handle_composition_prop}, {NULL, 0, NULL} }; @@ -1923,6 +1932,14 @@ get_glyph_string_clip_rects (s, rects, n) } } + if (s->row->clip) + { + XRectangle r_save = r; + + if (! x_intersect_rectangles (&r_save, s->row->clip, &r)) + r.width = 0; + } + if ((s->for_overlaps & OVERLAPS_BOTH) == 0 || ((s->for_overlaps & OVERLAPS_BOTH) == OVERLAPS_BOTH && n == 1)) { @@ -3533,7 +3550,7 @@ face_before_or_after_it_pos (it, before_p) struct face *face = FACE_FROM_ID (it->f, face_id); c = string_char_and_length (p, rest, &len); - face_id = FACE_FOR_CHAR (it->f, face, c); + face_id = FACE_FOR_CHAR (it->f, face, c, CHARPOS (pos), it->string); } } else @@ -3572,7 +3589,7 @@ face_before_or_after_it_pos (it, before_p) { int c = FETCH_MULTIBYTE_CHAR (BYTEPOS (pos)); struct face *face = FACE_FROM_ID (it->f, face_id); - face_id = FACE_FOR_CHAR (it->f, face, c); + face_id = FACE_FOR_CHAR (it->f, face, c, CHARPOS (pos), Qnil); } } @@ -4171,7 +4188,7 @@ handle_single_display_spec (it, spec, object, overlay, position, { Lisp_Object face_name = XCAR (XCDR (XCDR (spec))); int face_id2 = lookup_derived_face (it->f, face_name, - 'A', FRINGE_FACE_ID, 0); + FRINGE_FACE_ID, 0); if (face_id2 >= 0) face_id = face_id2; } @@ -4528,6 +4545,100 @@ string_buffer_position (w, string, around_charpos) `composition' property ***********************************************************************/ +static enum prop_handled +handle_auto_composed_prop (it) + struct it *it; +{ + enum prop_handled handled = HANDLED_NORMALLY; + + if (FUNCTIONP (Vauto_composition_function)) + { + Lisp_Object val = Qnil; + EMACS_INT pos, limit = -1; + + if (STRINGP (it->string)) + pos = IT_STRING_CHARPOS (*it); + else + pos = IT_CHARPOS (*it); + + val = Fget_text_property (make_number (pos), Qauto_composed, it->string); + if (! NILP (val)) + { + Lisp_Object cmp_prop; + EMACS_INT cmp_start, cmp_end; + +#ifdef USE_FONT_BACKEND + if (enable_font_backend + && get_property_and_range (pos, Qcomposition, &cmp_prop, + &cmp_start, &cmp_end, it->string) + && cmp_start == pos + && COMPOSITION_METHOD (cmp_prop) == COMPOSITION_WITH_GLYPH_STRING) + { + Lisp_Object gstring = COMPOSITION_COMPONENTS (cmp_prop); + Lisp_Object font_object = LGSTRING_FONT (gstring); + + if (! EQ (font_object, + font_at (-1, pos, FACE_FROM_ID (it->f, it->face_id), + it->w, it->string))) + /* We must re-compute the composition for the + different font. */ + val = Qnil; + } +#endif + if (! NILP (val)) + { + Lisp_Object end; + + /* As Fnext_single_char_property_change is very slow, we + limit the search to the current line. */ + if (STRINGP (it->string)) + limit = SCHARS (it->string); + else + limit = find_next_newline_no_quit (pos, 1); + end = Fnext_single_char_property_change (make_number (pos), + Qauto_composed, + it->string, + make_number (limit)); + + if (XINT (end) < limit) + /* The current point is auto-composed, but there exist + characters not yet composed beyond the + auto-composed region. There's a possiblity that + the last characters in the region may be newly + composed. */ + val = Qnil; + } + } + if (NILP (val)) + { + if (limit < 0) + limit = (STRINGP (it->string) ? SCHARS (it->string) + : find_next_newline_no_quit (pos, 1)); + if (pos < limit) + { + int count = SPECPDL_INDEX (); + Lisp_Object args[5]; + + args[0] = Vauto_composition_function; + specbind (Qauto_composition_function, Qnil); + args[1] = make_number (pos); + args[2] = make_number (limit); +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + args[3] = it->window; + else +#endif /* USE_FONT_BACKEND */ + args[3] = Qnil; + args[4] = it->string; + safe_call (5, args); + unbind_to (count, Qnil); + } + } + } + + return handled; +} + /* Set up iterator IT from `composition' property at its current position. Called from handle_stop. */ @@ -4536,7 +4647,7 @@ handle_composition_prop (it) struct it *it; { Lisp_Object prop, string; - int pos, pos_byte, end; + EMACS_INT pos, pos_byte, start, end; enum prop_handled handled = HANDLED_NORMALLY; if (STRINGP (it->string)) @@ -4555,11 +4666,20 @@ handle_composition_prop (it) /* If there's a valid composition and point is not inside of the composition (in the case that the composition is from the current buffer), draw a glyph composed from the composition components. */ - if (find_composition (pos, -1, &pos, &end, &prop, string) - && COMPOSITION_VALID_P (pos, end, prop) - && (STRINGP (it->string) || (PT <= pos || PT >= end))) + if (find_composition (pos, -1, &start, &end, &prop, string) + && COMPOSITION_VALID_P (start, end, prop) + && (STRINGP (it->string) || (PT <= start || PT >= end))) { - int id = get_composition_id (pos, pos_byte, end - pos, prop, string); + int id; + + if (start != pos) + { + if (STRINGP (it->string)) + pos_byte = string_char_to_byte (it->string, start); + else + pos_byte = CHAR_TO_BYTE (start); + } + id = get_composition_id (start, pos_byte, end - start, prop, string); if (id >= 0) { @@ -4588,9 +4708,29 @@ handle_composition_prop (it) it->method = GET_FROM_COMPOSITION; it->cmp_id = id; it->cmp_len = COMPOSITION_LENGTH (prop); - /* For a terminal, draw only the first character of the - components. */ - it->c = COMPOSITION_GLYPH (composition_table[id], 0); + /* For a terminal, draw only the first (non-TAB) character + of the components. */ +#ifdef USE_FONT_BACKEND + if (composition_table[id]->method == COMPOSITION_WITH_GLYPH_STRING) + { + Lisp_Object lgstring = AREF (XHASH_TABLE (composition_hash_table) + ->key_and_value, + cmp->hash_index * 2); + + it->c = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, 0)); + } + else +#endif /* USE_FONT_BACKEND */ + { + int i; + + for (i = 0; i < cmp->glyph_len; i++) + if ((it->c = COMPOSITION_GLYPH (composition_table[id], i)) + != '\t') + break; + } + if (it->c == '\t') + it->c = ' '; it->len = (STRINGP (it->string) ? string_char_to_byte (it->string, end) : CHAR_TO_BYTE (end)) - pos_byte; @@ -5251,7 +5391,7 @@ back_to_previous_visible_line_start (it) { struct it it2; int pos; - int beg, end; + EMACS_INT beg, end; Lisp_Object val, overlay; /* If newline is part of a composition, continue from start of composition */ @@ -5613,31 +5753,26 @@ get_next_display_element (it) the translation. This could easily be changed but I don't believe that it is worth doing. - If it->multibyte_p is nonzero, eight-bit characters and - non-printable multibyte characters are also translated to - octal form. + If it->multibyte_p is nonzero, non-printable non-ASCII + characters are also translated to octal form. If it->multibyte_p is zero, eight-bit characters that don't have corresponding multibyte char code are also translated to octal form. */ else if ((it->c < ' ' - && (it->area != TEXT_AREA - /* In mode line, treat \n like other crl chars. */ - || (it->c != '\t' - && it->glyph_row && it->glyph_row->mode_line_p) - || (it->c != '\n' && it->c != '\t'))) - || (it->multibyte_p - ? ((it->c >= 127 - && it->len == 1) - || !CHAR_PRINTABLE_P (it->c) + ? (it->area != TEXT_AREA + /* In mode line, treat \n, \t like other crl chars. */ + || (it->c != '\t' + && it->glyph_row && it->glyph_row->mode_line_p) + || (it->c != '\n' && it->c != '\t')) + : (it->multibyte_p + ? (!CHAR_PRINTABLE_P (it->c) || (!NILP (Vnobreak_char_display) - && (it->c == 0x8a0 || it->c == 0x8ad - || it->c == 0x920 || it->c == 0x92d - || it->c == 0xe20 || it->c == 0xe2d - || it->c == 0xf20 || it->c == 0xf2d))) + && (it->c == 0xA0 /* NO-BREAK SPACE */ + || it->c == 0xAD /* SOFT HYPHEN */))) : (it->c >= 127 - && (!unibyte_display_via_language_environment - || it->c == unibyte_char_to_multibyte (it->c))))) + && (! unibyte_display_via_language_environment + || (UNIBYTE_CHAR_HAS_MULTIBYTE_P (it->c))))))) { /* IT->c is a control character which must be displayed either as '\003' or as `^C' where the '\\' and '^' @@ -5694,8 +5829,7 @@ get_next_display_element (it) highlighting. */ if (EQ (Vnobreak_char_display, Qt) - && (it->c == 0x8a0 || it->c == 0x920 - || it->c == 0xe20 || it->c == 0xf20)) + && it->c == 0xA0) { /* Merge the no-break-space face into the current face. */ face_id = merge_faces (it->f, Qnobreak_space, 0, @@ -5746,8 +5880,7 @@ get_next_display_element (it) highlighting. */ if (EQ (Vnobreak_char_display, Qt) - && (it->c == 0x8ad || it->c == 0x92d - || it->c == 0xe2d || it->c == 0xf2d)) + && it->c == 0xAD) { g = it->c = '-'; XSETINT (it->ctl_chars[0], g); @@ -5758,13 +5891,10 @@ get_next_display_element (it) /* Handle non-break space and soft hyphen with the escape glyph. */ - if (it->c == 0x8a0 || it->c == 0x8ad - || it->c == 0x920 || it->c == 0x92d - || it->c == 0xe20 || it->c == 0xe2d - || it->c == 0xf20 || it->c == 0xf2d) + if (it->c == 0xA0 || it->c == 0xAD) { XSETINT (it->ctl_chars[0], escape_glyph); - g = it->c = ((it->c & 0xf) == 0 ? ' ' : '-'); + g = it->c = (it->c == 0xA0 ? ' ' : '-'); XSETINT (it->ctl_chars[1], g); ctl_len = 2; goto display_control; @@ -5776,23 +5906,27 @@ get_next_display_element (it) int i; /* Set IT->ctl_chars[0] to the glyph for `\\'. */ - if (SINGLE_BYTE_CHAR_P (it->c)) - str[0] = it->c, len = 1; + if (CHAR_BYTE8_P (it->c)) + { + str[0] = CHAR_TO_BYTE8 (it->c); + len = 1; + } + else if (it->c < 256) + { + str[0] = it->c; + len = 1; + } else { - len = CHAR_STRING_NO_SIGNAL (it->c, str); - if (len < 0) - { - /* It's an invalid character, which shouldn't - happen actually, but due to bugs it may - happen. Let's print the char as is, there's - not much meaningful we can do with it. */ - str[0] = it->c; - str[1] = it->c >> 8; - str[2] = it->c >> 16; - str[3] = it->c >> 24; - len = 4; - } + /* It's an invalid character, which shouldn't + happen actually, but due to bugs it may + happen. Let's print the char as is, there's + not much meaningful we can do with it. */ + str[0] = it->c; + str[1] = it->c >> 8; + str[2] = it->c >> 16; + str[3] = it->c >> 24; + len = 4; } for (i = 0; i < len; i++) @@ -5823,16 +5957,21 @@ get_next_display_element (it) goto get_next; } } + } - /* Adjust face id for a multibyte character. There are no - multibyte character in unibyte text. */ - if (it->multibyte_p - && success_p - && FRAME_WINDOW_P (it->f)) - { - struct face *face = FACE_FROM_ID (it->f, it->face_id); - it->face_id = FACE_FOR_CHAR (it->f, face, it->c); - } + /* Adjust face id for a multibyte character. There are no multibyte + character in unibyte text. */ + if ((it->what == IT_CHARACTER || it->what == IT_COMPOSITION) + && it->multibyte_p + && success_p + && FRAME_WINDOW_P (it->f)) + { + struct face *face = FACE_FROM_ID (it->f, it->face_id); + int pos = (it->s ? -1 + : STRINGP (it->string) ? IT_STRING_CHARPOS (*it) + : IT_CHARPOS (*it)); + + it->face_id = FACE_FOR_CHAR (it->f, face, it->c, pos, it->string); } /* Is this character the last one of a run of characters with @@ -6834,6 +6973,16 @@ move_it_to (it, to_charpos, to_x, to_y, to_vpos, op) the line. */ if (skip == MOVE_X_REACHED) { + /* Wait! We can conclude that TO_Y is in the line if + the already scanned glyphs make the line tall enough + because further scanning doesn't make it shorter. */ + line_height = it->max_ascent + it->max_descent; + if (to_y >= it->current_y + && to_y < it->current_y + line_height) + { + reached = 6; + break; + } it_backup = *it; TRACE_MOVE ((stderr, "move_it: from %d\n", IT_CHARPOS (*it))); skip2 = move_it_in_display_line_to (it, to_charpos, -1, @@ -7370,7 +7519,7 @@ message_dolog (m, nbytes, nlflag, multibyte) for (i = 0; i < nbytes; i += char_bytes) { c = string_char_and_length (m + i, nbytes - i, &char_bytes); - work[0] = (SINGLE_BYTE_CHAR_P (c) + work[0] = (ASCII_CHAR_P (c) ? c : multibyte_char_to_unibyte (c, Qnil)); insert_1_both (work, 1, 1, 1, 0, 0); @@ -7386,7 +7535,8 @@ message_dolog (m, nbytes, nlflag, multibyte) for the *Message* buffer. */ for (i = 0; i < nbytes; i++) { - c = unibyte_char_to_multibyte (msg[i]); + c = msg[i]; + c = unibyte_char_to_multibyte (c); char_bytes = CHAR_STRING (c, str); insert_1_both (str, 1, char_bytes, 1, 0, 0); } @@ -8671,7 +8821,7 @@ set_message_1 (a1, a2, nbytes, multibyte_p) for (i = 0; i < nbytes; i += n) { c = string_char_and_length (s + i, nbytes - i, &n); - work[0] = (SINGLE_BYTE_CHAR_P (c) + work[0] = (ASCII_CHAR_P (c) ? c : multibyte_char_to_unibyte (c, Qnil)); insert_1_both (work, 1, 1, 1, 0, 0); @@ -8688,7 +8838,8 @@ set_message_1 (a1, a2, nbytes, multibyte_p) /* Convert a single-byte string to multibyte. */ for (i = 0; i < nbytes; i++) { - c = unibyte_char_to_multibyte (msg[i]); + c = msg[i]; + c = unibyte_char_to_multibyte (c); n = CHAR_STRING (c, str); insert_1_both (str, 1, n, 1, 0, 0); } @@ -10786,7 +10937,7 @@ check_point_in_composition (prev_buf, prev_pt, buf, pt) struct buffer *prev_buf, *buf; int prev_pt, pt; { - int start, end; + EMACS_INT start, end; Lisp_Object prop; Lisp_Object buffer; @@ -11806,35 +11957,24 @@ disp_char_vector (dp, c) struct Lisp_Char_Table *dp; int c; { - int code[4], i; Lisp_Object val; - if (SINGLE_BYTE_CHAR_P (c)) - return (dp->contents[c]); - - SPLIT_CHAR (c, code[0], code[1], code[2]); - if (code[1] < 32) - code[1] = -1; - else if (code[2] < 32) - code[2] = -1; - - /* Here, the possible range of code[0] (== charset ID) is - 128..max_charset. Since the top level char table contains data - for multibyte characters after 256th element, we must increment - code[0] by 128 to get a correct index. */ - code[0] += 128; - code[3] = -1; /* anchor */ - - for (i = 0; code[i] >= 0; i++, dp = XCHAR_TABLE (val)) + if (ASCII_CHAR_P (c)) { - val = dp->contents[code[i]]; - if (!SUB_CHAR_TABLE_P (val)) - return (NILP (val) ? dp->defalt : val); + val = dp->ascii; + if (SUB_CHAR_TABLE_P (val)) + val = XSUB_CHAR_TABLE (val)->contents[c]; } + else + { + Lisp_Object table; - /* Here, val is a sub char table. We return the default value of - it. */ - return (dp->defalt); + XSETCHAR_TABLE (table, dp); + val = char_table_ref (table, c); + } + if (NILP (val)) + val = dp->defalt; + return val; } @@ -15760,7 +15900,7 @@ append_space_for_newline (it, default_face_p) else if (it->face_before_selective_p) it->face_id = it->saved_face_id; face = FACE_FROM_ID (it->f, it->face_id); - it->face_id = FACE_FOR_CHAR (it->f, face, 0); + it->face_id = FACE_FOR_CHAR (it->f, face, 0, -1, Qnil); PRODUCE_GLYPHS (it); @@ -15820,9 +15960,9 @@ extend_face_to_end_of_line (it) ASCII face. This will be automatically undone the next time get_next_display_element returns a multibyte character. Note that the character will always be single byte in unibyte text. */ - if (!SINGLE_BYTE_CHAR_P (it->c)) + if (!ASCII_CHAR_P (it->c)) { - it->face_id = FACE_FOR_CHAR (f, face, 0); + it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil); } if (FRAME_WINDOW_P (f)) @@ -15928,7 +16068,7 @@ highlight_trailing_whitespace (f, row) && glyph->u.ch == ' ')) && trailing_whitespace_p (glyph->charpos)) { - int face_id = lookup_named_face (f, Qtrailing_whitespace, 0, 0); + int face_id = lookup_named_face (f, Qtrailing_whitespace, 0); if (face_id < 0) return; @@ -17457,7 +17597,7 @@ are the selected window and the window's buffer). */) { if (EQ (face, Qt)) face = (EQ (window, selected_window) ? Qmode_line : Qmode_line_inactive); - face_id = lookup_named_face (XFRAME (WINDOW_FRAME (w)), face, 0, 0); + face_id = lookup_named_face (XFRAME (WINDOW_FRAME (w)), face, 0); } if (face_id < 0) @@ -17680,7 +17820,7 @@ decode_mode_spec_coding (coding_system, buf, eol_flag) /* The EOL conversion we are using. */ Lisp_Object eoltype; - val = Fget (coding_system, Qcoding_system); + val = CODING_SYSTEM_SPEC (coding_system); eoltype = Qnil; if (!VECTORP (val)) /* Not yet decided. */ @@ -17693,12 +17833,14 @@ decode_mode_spec_coding (coding_system, buf, eol_flag) } else { + Lisp_Object attrs; Lisp_Object eolvalue; - eolvalue = Fget (coding_system, Qeol_type); + attrs = AREF (val, 0); + eolvalue = AREF (val, 2); if (multibyte) - *buf++ = XFASTINT (AREF (val, 1)); + *buf++ = XFASTINT (CODING_ATTR_MNEMONIC (attrs)); if (eol_flag) { @@ -17708,10 +17850,10 @@ decode_mode_spec_coding (coding_system, buf, eol_flag) eoltype = eol_mnemonic_undecided; else if (VECTORP (eolvalue)) /* Not yet decided. */ eoltype = eol_mnemonic_undecided; - else /* INTEGERP (eolvalue) -- 0:LF, 1:CRLF, 2:CR */ - eoltype = (XFASTINT (eolvalue) == 0 + else /* eolvalue is Qunix, Qdos, or Qmac. */ + eoltype = (EQ (eolvalue, Qunix) ? eol_mnemonic_unix - : (XFASTINT (eolvalue) == 1 + : (EQ (eolvalue, Qdos) == 1 ? eol_mnemonic_dos : eol_mnemonic_mac)); } } @@ -17724,8 +17866,7 @@ decode_mode_spec_coding (coding_system, buf, eol_flag) eol_str = SDATA (eoltype); eol_str_len = SBYTES (eoltype); } - else if (INTEGERP (eoltype) - && CHAR_VALID_P (XINT (eoltype), 0)) + else if (CHARACTERP (eoltype)) { unsigned char *tmp = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH); eol_str_len = CHAR_STRING (XINT (eoltype), tmp); @@ -18129,8 +18270,12 @@ decode_mode_spec (w, c, field_width, precision, multibyte) { /* No need to mention EOL here--the terminal never needs to do EOL conversion. */ - p = decode_mode_spec_coding (FRAME_KEYBOARD_CODING (f)->symbol, p, 0); - p = decode_mode_spec_coding (FRAME_TERMINAL_CODING (f)->symbol, p, 0); + p = decode_mode_spec_coding (CODING_ID_NAME + (FRAME_KEYBOARD_CODING (f)->id), + p, 0); + p = decode_mode_spec_coding (CODING_ID_NAME + (FRAME_TERMINAL_CODING (f)->id), + p, 0); } p = decode_mode_spec_coding (b->buffer_file_coding_system, p, eol_flag); @@ -18402,7 +18547,7 @@ display_string (string, lisp_string, face_string, face_string_pos, } break; } - else if (x + glyph->pixel_width > it->first_visible_x) + else if (x + glyph->pixel_width >= it->first_visible_x) { /* Glyph is at least partially visible. */ ++it->hpos; @@ -18954,6 +19099,80 @@ append_glyph_string (head, tail, s) } +/* Get face and two-byte form of character C in face FACE_ID on frame + F. The encoding of C is returned in *CHAR2B. MULTIBYTE_P non-zero + means we want to display multibyte text. DISPLAY_P non-zero means + make sure that X resources for the face returned are allocated. + Value is a pointer to a realized face that is ready for display if + DISPLAY_P is non-zero. */ + +static INLINE struct face * +get_char_face_and_encoding (f, c, face_id, char2b, multibyte_p, display_p) + struct frame *f; + int c, face_id; + XChar2b *char2b; + int multibyte_p, display_p; +{ + struct face *face = FACE_FROM_ID (f, face_id); + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + struct font *font = (struct font *) face->font_info; + + if (font) + { + unsigned code = font->driver->encode_char (font, c); + + if (code != FONT_INVALID_CODE) + STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); + else + STORE_XCHAR2B (char2b, 0, 0); + } + } + else +#endif /* USE_FONT_BACKEND */ + if (!multibyte_p) + { + /* Unibyte case. We don't have to encode, but we have to make + sure to use a face suitable for unibyte. */ + STORE_XCHAR2B (char2b, 0, c); + face_id = FACE_FOR_CHAR (f, face, c, -1, Qnil); + face = FACE_FROM_ID (f, face_id); + } + else if (c < 128) + { + /* Case of ASCII in a face known to fit ASCII. */ + STORE_XCHAR2B (char2b, 0, c); + } + else if (face->font != NULL) + { + struct font_info *font_info + = FONT_INFO_FROM_ID (f, face->font_info_id); + struct charset *charset = CHARSET_FROM_ID (font_info->charset); + unsigned code = ENCODE_CHAR (charset, c); + + if (CHARSET_DIMENSION (charset) == 1) + STORE_XCHAR2B (char2b, 0, code); + else + STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); + /* Maybe encode the character in *CHAR2B. */ + FRAME_RIF (f)->encode_char (c, char2b, font_info, charset, NULL); + } + + /* Make sure X resources of the face are allocated. */ +#ifdef HAVE_X_WINDOWS + if (display_p) +#endif + { + xassert (face != NULL); + PREPARE_FACE_FOR_DISPLAY (f, face); + } + + return face; +} + + /* Get face and two-byte form of character glyph GLYPH on frame F. The encoding of GLYPH->u.ch is returned in *CHAR2B. Value is a pointer to a realized face that is ready for display. */ @@ -18973,6 +19192,23 @@ get_glyph_face_and_encoding (f, glyph, char2b, two_byte_p) if (two_byte_p) *two_byte_p = 0; +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + struct font *font = (struct font *) face->font_info; + + if (font) + { + unsigned code = font->driver->encode_char (font, glyph->u.ch); + + if (code != FONT_INVALID_CODE) + STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); + else + STORE_XCHAR2B (char2b, 0, code); + } + } + else +#endif /* USE_FONT_BACKEND */ if (!glyph->multibyte_p) { /* Unibyte case. We don't have to encode, but we have to make @@ -18986,24 +19222,25 @@ get_glyph_face_and_encoding (f, glyph, char2b, two_byte_p) } else { - int c1, c2, charset; + struct font_info *font_info + = FONT_INFO_FROM_ID (f, face->font_info_id); + if (font_info) + { + struct charset *charset = CHARSET_FROM_ID (font_info->charset); + unsigned code = ENCODE_CHAR (charset, glyph->u.ch); - /* Split characters into bytes. If c2 is -1 afterwards, C is - really a one-byte character so that byte1 is zero. */ - SPLIT_CHAR (glyph->u.ch, charset, c1, c2); - if (c2 > 0) - STORE_XCHAR2B (char2b, c1, c2); - else - STORE_XCHAR2B (char2b, 0, c1); + if (CHARSET_DIMENSION (charset) == 1) + STORE_XCHAR2B (char2b, 0, code); + else + STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); - /* Maybe encode the character in *CHAR2B. */ - if (charset != CHARSET_ASCII) - { - struct font_info *font_info - = FONT_INFO_FROM_ID (f, face->font_info_id); - if (font_info) - glyph->font_type - = FRAME_RIF (f)->encode_char (glyph->u.ch, char2b, font_info, two_byte_p); + /* Maybe encode the character in *CHAR2B. */ + if (CHARSET_ID (charset) != charset_ascii) + { + glyph->font_type + = FRAME_RIF (f)->encode_char (glyph->u.ch, char2b, font_info, + charset, two_byte_p); + } } } @@ -19016,7 +19253,7 @@ get_glyph_face_and_encoding (f, glyph, char2b, two_byte_p) /* Fill glyph string S with composition components specified by S->cmp. - FACES is an array of faces for all components of this composition. + BASE_FACE is the base face of the composition. S->gidx is the index of the first component for S. OVERLAPS non-zero means S should draw the foreground only, and use @@ -19025,9 +19262,9 @@ get_glyph_face_and_encoding (f, glyph, char2b, two_byte_p) Value is the index of a component not in S. */ static int -fill_composite_glyph_string (s, faces, overlaps) +fill_composite_glyph_string (s, base_face, overlaps) struct glyph_string *s; - struct face **faces; + struct face *base_face; int overlaps; { int i; @@ -19036,21 +19273,69 @@ fill_composite_glyph_string (s, faces, overlaps) s->for_overlaps = overlaps; - s->face = faces[s->gidx]; - s->font = s->face->font; - s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id); +#ifdef USE_FONT_BACKEND + if (enable_font_backend && s->cmp->method == COMPOSITION_WITH_GLYPH_STRING) + { + Lisp_Object gstring + = AREF (XHASH_TABLE (composition_hash_table)->key_and_value, + s->cmp->hash_index * 2); - /* For all glyphs of this composition, starting at the offset - S->gidx, until we reach the end of the definition or encounter a - glyph that requires the different face, add it to S. */ - ++s->nchars; - for (i = s->gidx + 1; i < s->cmp->glyph_len && faces[i] == s->face; ++i) - ++s->nchars; + s->face = base_face; + s->font_info = s->cmp->font; + s->font = s->font_info->font; + for (i = 0, s->nchars = 0; i < s->cmp->glyph_len; i++, s->nchars++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring, i); + unsigned code; + XChar2b * store_pos; + if (NILP (g)) + break; + code = LGLYPH_CODE (g); + store_pos = s->char2b + i; + STORE_XCHAR2B (store_pos, code >> 8, code & 0xFF); + } + s->width = s->cmp->pixel_width; + } + else +#endif /* USE_FONT_BACKEND */ + { + /* For all glyphs of this composition, starting at the offset + S->gidx, until we reach the end of the definition or encounter a + glyph that requires the different face, add it to S. */ + struct face *face; - /* All glyph strings for the same composition has the same width, - i.e. the width set for the first component of the composition. */ + s->face = NULL; + s->font = NULL; + s->font_info = NULL; + for (i = s->gidx; i < s->cmp->glyph_len; i++) + { + int c = COMPOSITION_GLYPH (s->cmp, i); - s->width = s->first_glyph->pixel_width; + if (c != '\t') + { + int face_id = FACE_FOR_CHAR (s->f, base_face, c, -1, Qnil); + + face = get_char_face_and_encoding (s->f, c, face_id, + s->char2b + i, 1, 1); + if (face) + { + if (! s->face) + { + s->face = face; + s->font = s->face->font; + s->font_info = FONT_INFO_FROM_FACE (s->f, s->face); + } + else if (s->face != face) + break; + } + } + ++s->nchars; + } + + /* All glyph strings for the same composition has the same width, + i.e. the width set for the first component of the composition. */ + s->width = s->first_glyph->pixel_width; + } /* If the specified font could not be loaded, use the frame's default font, but record the fact that we couldn't load it in @@ -19065,8 +19350,6 @@ fill_composite_glyph_string (s, faces, overlaps) /* Adjust base line for subscript/superscript text. */ s->ybase += s->first_glyph->voffset; - xassert (s->face && s->face->gc); - /* This glyph string must always be drawn with 16-bit functions. */ s->two_byte_p = 1; @@ -19124,7 +19407,7 @@ fill_glyph_string (s, face_id, start, end, overlaps) } s->font = s->face->font; - s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id); + s->font_info = FONT_INFO_FROM_FACE (s->f, s->face); /* If the specified font could not be loaded, use the frame's font, but record the fact that we couldn't load it in @@ -19188,7 +19471,7 @@ fill_stretch_glyph_string (s, row, area, start, end) face_id = glyph->face_id; s->face = FACE_FROM_ID (s->f, face_id); s->font = s->face->font; - s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id); + s->font_info = FONT_INFO_FROM_FACE (s->f, s->face); s->width = glyph->pixel_width; s->nchars = 1; voffset = glyph->voffset; @@ -19210,6 +19493,36 @@ fill_stretch_glyph_string (s, row, area, start, end) return glyph - s->row->glyphs[s->area]; } +static XCharStruct * +get_per_char_metric (f, font, font_info, char2b, font_type) + struct frame *f; + XFontStruct *font; + struct font_info *font_info; + XChar2b *char2b; + int font_type; +{ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + static XCharStruct pcm_value; + unsigned code = (XCHAR2B_BYTE1 (char2b) << 8) | XCHAR2B_BYTE2 (char2b); + struct font *fontp; + struct font_metrics metrics; + + if (! font_info || code == FONT_INVALID_CODE) + return NULL; + fontp = (struct font *) font_info; + fontp->driver->text_extents (fontp, &code, 1, &metrics); + pcm_value.lbearing = metrics.lbearing; + pcm_value.rbearing = metrics.rbearing; + pcm_value.ascent = metrics.ascent; + pcm_value.descent = metrics.descent; + pcm_value.width = metrics.width; + return &pcm_value; + } +#endif /* USE_FONT_BACKEND */ + return FRAME_RIF (f)->per_char_metric (font, char2b, font_type); +} /* EXPORT for RIF: Set *LEFT and *RIGHT to the left and right overhang of GLYPH on @@ -19234,9 +19547,9 @@ x_get_glyph_overhangs (glyph, f, left, right) face = get_glyph_face_and_encoding (f, glyph, &char2b, NULL); font = face->font; - font_info = FONT_INFO_FROM_ID (f, face->font_info_id); + font_info = FONT_INFO_FROM_FACE (f, face); if (font /* ++KFS: Should this be font_info ? */ - && (pcm = FRAME_RIF (f)->per_char_metric (font, &char2b, glyph->font_type))) + && (pcm = get_per_char_metric (f, font, font_info, &char2b, glyph->font_type))) { if (pcm->rbearing > pcm->width) *right = pcm->rbearing - pcm->width; @@ -19244,6 +19557,13 @@ x_get_glyph_overhangs (glyph, f, left, right) *left = -pcm->lbearing; } } + else if (glyph->type == COMPOSITE_GLYPH) + { + struct composition *cmp = composition_table[glyph->u.cmp_id]; + + *right = cmp->rbearing - cmp->pixel_width; + *left = - cmp->lbearing; + } } @@ -19357,70 +19677,6 @@ right_overwriting (s) } -/* Get face and two-byte form of character C in face FACE_ID on frame - F. The encoding of C is returned in *CHAR2B. MULTIBYTE_P non-zero - means we want to display multibyte text. DISPLAY_P non-zero means - make sure that X resources for the face returned are allocated. - Value is a pointer to a realized face that is ready for display if - DISPLAY_P is non-zero. */ - -static INLINE struct face * -get_char_face_and_encoding (f, c, face_id, char2b, multibyte_p, display_p) - struct frame *f; - int c, face_id; - XChar2b *char2b; - int multibyte_p, display_p; -{ - struct face *face = FACE_FROM_ID (f, face_id); - - if (!multibyte_p) - { - /* Unibyte case. We don't have to encode, but we have to make - sure to use a face suitable for unibyte. */ - STORE_XCHAR2B (char2b, 0, c); - face_id = FACE_FOR_CHAR (f, face, c); - face = FACE_FROM_ID (f, face_id); - } - else if (c < 128) - { - /* Case of ASCII in a face known to fit ASCII. */ - STORE_XCHAR2B (char2b, 0, c); - } - else - { - int c1, c2, charset; - - /* Split characters into bytes. If c2 is -1 afterwards, C is - really a one-byte character so that byte1 is zero. */ - SPLIT_CHAR (c, charset, c1, c2); - if (c2 > 0) - STORE_XCHAR2B (char2b, c1, c2); - else - STORE_XCHAR2B (char2b, 0, c1); - - /* Maybe encode the character in *CHAR2B. */ - if (face->font != NULL) - { - struct font_info *font_info - = FONT_INFO_FROM_ID (f, face->font_info_id); - if (font_info) - FRAME_RIF (f)->encode_char (c, char2b, font_info, 0); - } - } - - /* Make sure X resources of the face are allocated. */ -#ifdef HAVE_X_WINDOWS - if (display_p) -#endif - { - xassert (face != NULL); - PREPARE_FACE_FOR_DISPLAY (f, face); - } - - return face; -} - - /* Set background width of glyph string S. START is the index of the first glyph following S. LAST_X is the right-most x-position + 1 in the drawing area. */ @@ -19560,10 +19816,9 @@ compute_overhangs_and_x (s, x, backward_p) #define BUILD_CHAR_GLYPH_STRINGS(START, END, HEAD, TAIL, HL, X, LAST_X) \ do \ { \ - int c, face_id; \ + int face_id; \ XChar2b *char2b; \ \ - c = (row)->glyphs[area][START].u.ch; \ face_id = (row)->glyphs[area][START].face_id; \ \ s = (struct glyph_string *) alloca (sizeof *s); \ @@ -19586,49 +19841,35 @@ compute_overhangs_and_x (s, x, backward_p) x-position of the drawing area. */ #define BUILD_COMPOSITE_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \ - do { \ - int cmp_id = (row)->glyphs[area][START].u.cmp_id; \ - int face_id = (row)->glyphs[area][START].face_id; \ - struct face *base_face = FACE_FROM_ID (f, face_id); \ - struct composition *cmp = composition_table[cmp_id]; \ - int glyph_len = cmp->glyph_len; \ - XChar2b *char2b; \ - struct face **faces; \ - struct glyph_string *first_s = NULL; \ - int n; \ - \ - base_face = base_face->ascii_face; \ - char2b = (XChar2b *) alloca ((sizeof *char2b) * glyph_len); \ - faces = (struct face **) alloca ((sizeof *faces) * glyph_len); \ - /* At first, fill in `char2b' and `faces'. */ \ - for (n = 0; n < glyph_len; n++) \ - { \ - int c = COMPOSITION_GLYPH (cmp, n); \ - int this_face_id = FACE_FOR_CHAR (f, base_face, c); \ - faces[n] = FACE_FROM_ID (f, this_face_id); \ - get_char_face_and_encoding (f, c, this_face_id, \ - char2b + n, 1, 1); \ - } \ - \ - /* Make glyph_strings for each glyph sequence that is drawable by \ - the same face, and append them to HEAD/TAIL. */ \ - for (n = 0; n < cmp->glyph_len;) \ - { \ - s = (struct glyph_string *) alloca (sizeof *s); \ - INIT_GLYPH_STRING (s, char2b + n, w, row, area, START, HL); \ - append_glyph_string (&(HEAD), &(TAIL), s); \ - s->cmp = cmp; \ - s->gidx = n; \ - s->x = (X); \ - \ - if (n == 0) \ - first_s = s; \ - \ - n = fill_composite_glyph_string (s, faces, overlaps); \ - } \ - \ - ++START; \ - s = first_s; \ + do { \ + int face_id = (row)->glyphs[area][START].face_id; \ + struct face *base_face = FACE_FROM_ID (f, face_id); \ + int cmp_id = (row)->glyphs[area][START].u.cmp_id; \ + struct composition *cmp = composition_table[cmp_id]; \ + XChar2b *char2b; \ + struct glyph_string *first_s; \ + int n; \ + \ + char2b = (XChar2b *) alloca ((sizeof *char2b) * cmp->glyph_len); \ + base_face = base_face->ascii_face; \ + \ + /* Make glyph_strings for each glyph sequence that is drawable by \ + the same face, and append them to HEAD/TAIL. */ \ + for (n = 0; n < cmp->glyph_len;) \ + { \ + s = (struct glyph_string *) alloca (sizeof *s); \ + INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \ + append_glyph_string (&(HEAD), &(TAIL), s); \ + s->cmp = cmp; \ + s->gidx = n; \ + s->x = (X); \ + if (n == 0) \ + first_s = s; \ + n = fill_composite_glyph_string (s, base_face, overlaps); \ + } \ + \ + ++START; \ + s = first_s; \ } while (0) @@ -19675,8 +19916,11 @@ compute_overhangs_and_x (s, x, backward_p) abort (); \ } \ \ - set_glyph_string_background_width (s, START, LAST_X); \ - (X) += s->width; \ + if (s) \ + { \ + set_glyph_string_background_width (s, START, LAST_X); \ + (X) += s->width; \ + } \ } \ } \ while (0) @@ -19710,7 +19954,7 @@ draw_glyphs (w, x, row, area, start, end, hl, overlaps) int x; struct glyph_row *row; enum glyph_row_area area; - int start, end; + EMACS_INT start, end; enum draw_glyphs_face hl; int overlaps; { @@ -19830,6 +20074,7 @@ draw_glyphs (w, x, row, area, start, end, hl, overlaps) if (i >= 0) { clip_tail = tail; + i++; /* We must include the Ith glyph. */ BUILD_GLYPH_STRINGS (end, i, h, t, DRAW_NORMAL_TEXT, x, last_x); for (s = h; s; s = s->next) @@ -20419,7 +20664,7 @@ calc_line_height_property (it, val, font, boff, override) struct face *face; struct font_info *font_info; - face_id = lookup_named_face (it->f, face_name, ' ', 0); + face_id = lookup_named_face (it->f, face_name, 0); if (face_id < 0) return make_number (-1); @@ -20428,7 +20673,7 @@ calc_line_height_property (it, val, font, boff, override) if (font == NULL) return make_number (-1); - font_info = FONT_INFO_FROM_ID (it->f, face->font_info_id); + font_info = FONT_INFO_FROM_FACE (it->f, face); boff = font_info->baseline_offset; if (font_info->vertical_centering) boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; @@ -20492,23 +20737,17 @@ x_produce_glyphs (it) /* Maybe translate single-byte characters to multibyte, or the other way. */ it->char_to_display = it->c; - if (!ASCII_BYTE_P (it->c)) + if (!ASCII_BYTE_P (it->c) + && ! it->multibyte_p) { - if (unibyte_display_via_language_environment - && SINGLE_BYTE_CHAR_P (it->c) - && (it->c >= 0240 - || !NILP (Vnonascii_translation_table))) - { - it->char_to_display = unibyte_char_to_multibyte (it->c); - it->multibyte_p = 1; - it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display); - face = FACE_FROM_ID (it->f, it->face_id); - } - else if (!SINGLE_BYTE_CHAR_P (it->c) - && !it->multibyte_p) + if (SINGLE_BYTE_CHAR_P (it->c) + && unibyte_display_via_language_environment) + it->char_to_display = unibyte_char_to_multibyte (it->c); + if (! SINGLE_BYTE_CHAR_P (it->char_to_display)) { it->multibyte_p = 1; - it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display); + it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display, + -1, Qnil); face = FACE_FROM_ID (it->f, it->face_id); } } @@ -20528,7 +20767,7 @@ x_produce_glyphs (it) } else { - font_info = FONT_INFO_FROM_ID (it->f, face->font_info_id); + font_info = FONT_INFO_FROM_FACE (it->f, face); boff = font_info->baseline_offset; if (font_info->vertical_centering) boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; @@ -20542,8 +20781,8 @@ x_produce_glyphs (it) it->nglyphs = 1; - pcm = FRAME_RIF (it->f)->per_char_metric - (font, &char2b, FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display)); + pcm = get_per_char_metric (it->f, font, font_info, &char2b, + FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display)); if (it->override_ascent >= 0) { @@ -20769,20 +21008,24 @@ x_produce_glyphs (it) /* If we found a font, this font should give us the right metrics. If we didn't find a font, use the frame's - default font and calculate the width of the character - from the charset width; this is what old redisplay code - did. */ + default font and calculate the width of the character by + multiplying the width of font by the width of the + character. */ - pcm = FRAME_RIF (it->f)->per_char_metric (font, &char2b, - FONT_TYPE_FOR_MULTIBYTE (font, it->c)); + pcm = get_per_char_metric (it->f, font, font_info, &char2b, + FONT_TYPE_FOR_MULTIBYTE (font, it->c)); if (font_not_found_p || !pcm) { - int charset = CHAR_CHARSET (it->char_to_display); + int char_width = CHAR_WIDTH (it->char_to_display); + if (char_width == 0) + /* This is a non spacing character. But, as we are + going to display an empty box, the box must occupy + at least one column. */ + char_width = 1; it->glyph_not_available_p = 1; - it->pixel_width = (FRAME_COLUMN_WIDTH (it->f) - * CHARSET_WIDTH (charset)); + it->pixel_width = FRAME_COLUMN_WIDTH (it->f) * char_width; it->phys_ascent = FONT_BASE (font) + boff; it->phys_descent = FONT_DESCENT (font) - boff; } @@ -20832,99 +21075,120 @@ x_produce_glyphs (it) else if (it->what == IT_COMPOSITION) { /* Note: A composition is represented as one glyph in the - glyph matrix. There are no padding glyphs. */ - XChar2b char2b; - XFontStruct *font; + glyph matrix. There are no padding glyphs. + + Important is that pixel_width, ascent, and descent are the + values of what is drawn by draw_glyphs (i.e. the values of + the overall glyphs composed). */ struct face *face = FACE_FROM_ID (it->f, it->face_id); - XCharStruct *pcm; - int font_not_found_p; - struct font_info *font_info; int boff; /* baseline offset */ struct composition *cmp = composition_table[it->cmp_id]; + int glyph_len = cmp->glyph_len; + XFontStruct *font = face->font; - /* Maybe translate single-byte characters to multibyte. */ - it->char_to_display = it->c; - if (unibyte_display_via_language_environment - && SINGLE_BYTE_CHAR_P (it->c) - && (it->c >= 0240 - || (it->c >= 0200 - && !NILP (Vnonascii_translation_table)))) - { - it->char_to_display = unibyte_char_to_multibyte (it->c); - } - - /* Get face and font to use. Encode IT->char_to_display. */ - it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display); - face = FACE_FROM_ID (it->f, it->face_id); - get_char_face_and_encoding (it->f, it->char_to_display, it->face_id, - &char2b, it->multibyte_p, 0); - font = face->font; + it->nglyphs = 1; - /* When no suitable font found, use the default font. */ - font_not_found_p = font == NULL; - if (font_not_found_p) +#ifdef USE_FONT_BACKEND + if (cmp->method == COMPOSITION_WITH_GLYPH_STRING) { - font = FRAME_FONT (it->f); - boff = FRAME_BASELINE_OFFSET (it->f); - font_info = NULL; + if (! cmp->font || cmp->font != font) + font_prepare_composition (cmp, it->f); } else - { - font_info = FONT_INFO_FROM_ID (it->f, face->font_info_id); - boff = font_info->baseline_offset; - if (font_info->vertical_centering) - boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; - } - - /* There are no padding glyphs, so there is only one glyph to - produce for the composition. Important is that pixel_width, - ascent and descent are the values of what is drawn by - draw_glyphs (i.e. the values of the overall glyphs composed). */ - it->nglyphs = 1; - +#endif /* USE_FONT_BACKEND */ /* If we have not yet calculated pixel size data of glyphs of the composition for the current face font, calculate them now. Theoretically, we have to check all fonts for the glyphs, but that requires much time and memory space. So, here we check only the font of the first glyph. This leads - to incorrect display very rarely, and C-l (recenter) can - correct the display anyway. */ - if (cmp->font != (void *) font) - { - /* Ascent and descent of the font of the first character of - this composition (adjusted by baseline offset). Ascent - and descent of overall glyphs should not be less than - them respectively. */ - int font_ascent = FONT_BASE (font) + boff; - int font_descent = FONT_DESCENT (font) - boff; + to incorrect display, but it's very rare, and C-l (recenter) + can correct the display anyway. */ + if (! cmp->font || cmp->font != font) + { + /* Ascent and descent of the font of the first character + of this composition (adjusted by baseline offset). + Ascent and descent of overall glyphs should not be less + than them respectively. */ + int font_ascent, font_descent, font_height; /* Bounding box of the overall glyphs. */ int leftmost, rightmost, lowest, highest; + int lbearing, rbearing; int i, width, ascent, descent; + int left_padded = 0, right_padded = 0; + int face_id; + int c; + XChar2b char2b; + XCharStruct *pcm; + int font_not_found_p; + struct font_info *font_info; + int pos; + + for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--) + if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t') + break; + if (glyph_len < cmp->glyph_len) + right_padded = 1; + for (i = 0; i < glyph_len; i++) + { + if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t') + break; + cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0; + } + if (i > 0) + left_padded = 1; + + pos = (STRINGP (it->string) ? IT_STRING_CHARPOS (*it) + : IT_CHARPOS (*it)); + /* When no suitable font found, use the default font. */ + font_not_found_p = font == NULL; + if (font_not_found_p) + { + face = face->ascii_face; + font = face->font; + } + font_info = FONT_INFO_FROM_FACE (it->f, face); + boff = font_info->baseline_offset; + if (font_info->vertical_centering) + boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; + font_ascent = FONT_BASE (font) + boff; + font_descent = FONT_DESCENT (font) - boff; + font_height = FONT_HEIGHT (font); cmp->font = (void *) font; + pcm = NULL; + if (! font_not_found_p) + { + get_char_face_and_encoding (it->f, c, it->face_id, + &char2b, it->multibyte_p, 0); + pcm = get_per_char_metric (it->f, font, font_info, &char2b, + FONT_TYPE_FOR_MULTIBYTE (font, c)); + } + /* Initialize the bounding box. */ - if (font_info - && (pcm = FRAME_RIF (it->f)->per_char_metric (font, &char2b, - FONT_TYPE_FOR_MULTIBYTE (font, it->c)))) + if (pcm) { width = pcm->width; ascent = pcm->ascent; descent = pcm->descent; + lbearing = pcm->lbearing; + rbearing = pcm->rbearing; } else { width = FONT_WIDTH (font); ascent = FONT_BASE (font); descent = FONT_DESCENT (font); + lbearing = 0; + rbearing = width; } rightmost = width; + leftmost = 0; lowest = - descent + boff; highest = ascent + boff; - leftmost = 0; - if (font_info + if (! font_not_found_p && font_info->default_ascent && CHAR_TABLE_P (Vuse_default_ascent) && !NILP (Faref (Vuse_default_ascent, @@ -20932,123 +21196,138 @@ x_produce_glyphs (it) highest = font_info->default_ascent + boff; /* Draw the first glyph at the normal position. It may be - shifted to right later if some other glyphs are drawn at - the left. */ - cmp->offsets[0] = 0; - cmp->offsets[1] = boff; + shifted to right later if some other glyphs are drawn + at the left. */ + cmp->offsets[i * 2] = 0; + cmp->offsets[i * 2 + 1] = boff; + cmp->lbearing = lbearing; + cmp->rbearing = rbearing; /* Set cmp->offsets for the remaining glyphs. */ - for (i = 1; i < cmp->glyph_len; i++) + for (i++; i < glyph_len; i++) { int left, right, btm, top; int ch = COMPOSITION_GLYPH (cmp, i); - int face_id = FACE_FOR_CHAR (it->f, face, ch); + int face_id; + struct face *this_face; + int this_boff; + + if (ch == '\t') + ch = ' '; + face_id = FACE_FOR_CHAR (it->f, face, ch, pos, it->string); + this_face = FACE_FROM_ID (it->f, face_id); + font = this_face->font; - face = FACE_FROM_ID (it->f, face_id); - get_char_face_and_encoding (it->f, ch, face->id, - &char2b, it->multibyte_p, 0); - font = face->font; if (font == NULL) - { - font = FRAME_FONT (it->f); - boff = FRAME_BASELINE_OFFSET (it->f); - font_info = NULL; - } + pcm = NULL; else { - font_info - = FONT_INFO_FROM_ID (it->f, face->font_info_id); - boff = font_info->baseline_offset; + font_info = FONT_INFO_FROM_FACE (it->f, this_face); + this_boff = font_info->baseline_offset; if (font_info->vertical_centering) - boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; + this_boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; + get_char_face_and_encoding (it->f, ch, face_id, + &char2b, it->multibyte_p, 0); + pcm = get_per_char_metric (it->f, font, font_info, &char2b, + FONT_TYPE_FOR_MULTIBYTE (font, + ch)); } - - if (font_info - && (pcm = FRAME_RIF (it->f)->per_char_metric (font, &char2b, - FONT_TYPE_FOR_MULTIBYTE (font, ch)))) + if (! pcm) + cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0; + else { width = pcm->width; ascent = pcm->ascent; descent = pcm->descent; - } - else - { - width = FONT_WIDTH (font); - ascent = 1; - descent = 0; - } + lbearing = pcm->lbearing; + rbearing = pcm->rbearing; + if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS) + { + /* Relative composition with or without + alternate chars. */ + left = (leftmost + rightmost - width) / 2; + btm = - descent + boff; + if (font_info->relative_compose + && (! CHAR_TABLE_P (Vignore_relative_composition) + || NILP (Faref (Vignore_relative_composition, + make_number (ch))))) + { - if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS) - { - /* Relative composition with or without - alternate chars. */ - left = (leftmost + rightmost - width) / 2; - btm = - descent + boff; - if (font_info && font_info->relative_compose - && (! CHAR_TABLE_P (Vignore_relative_composition) - || NILP (Faref (Vignore_relative_composition, - make_number (ch))))) + if (- descent >= font_info->relative_compose) + /* One extra pixel between two glyphs. */ + btm = highest + 1; + else if (ascent <= 0) + /* One extra pixel between two glyphs. */ + btm = lowest - 1 - ascent - descent; + } + } + else { + /* A composition rule is specified by an integer + value that encodes global and new reference + points (GREF and NREF). GREF and NREF are + specified by numbers as below: + + 0---1---2 -- ascent + | | + | | + | | + 9--10--11 -- center + | | + ---3---4---5--- baseline + | | + 6---7---8 -- descent + */ + int rule = COMPOSITION_RULE (cmp, i); + int gref, nref, grefx, grefy, nrefx, nrefy, xoff, yoff; + + COMPOSITION_DECODE_RULE (rule, gref, nref, xoff, yoff); + grefx = gref % 3, nrefx = nref % 3; + grefy = gref / 3, nrefy = nref / 3; + if (xoff) + xoff = font_height * (xoff - 128) / 256; + if (yoff) + yoff = font_height * (yoff - 128) / 256; + + left = (leftmost + + grefx * (rightmost - leftmost) / 2 + - nrefx * width / 2 + + xoff); + + btm = ((grefy == 0 ? highest + : grefy == 1 ? 0 + : grefy == 2 ? lowest + : (highest + lowest) / 2) + - (nrefy == 0 ? ascent + descent + : nrefy == 1 ? descent - boff + : nrefy == 2 ? 0 + : (ascent + descent) / 2) + + yoff); + } + + cmp->offsets[i * 2] = left; + cmp->offsets[i * 2 + 1] = btm + descent; - if (- descent >= font_info->relative_compose) - /* One extra pixel between two glyphs. */ - btm = highest + 1; - else if (ascent <= 0) - /* One extra pixel between two glyphs. */ - btm = lowest - 1 - ascent - descent; + /* Update the bounding box of the overall glyphs. */ + if (width > 0) + { + right = left + width; + if (left < leftmost) + leftmost = left; + if (right > rightmost) + rightmost = right; } + top = btm + descent + ascent; + if (top > highest) + highest = top; + if (btm < lowest) + lowest = btm; + + if (cmp->lbearing > left + lbearing) + cmp->lbearing = left + lbearing; + if (cmp->rbearing < left + rbearing) + cmp->rbearing = left + rbearing; } - else - { - /* A composition rule is specified by an integer - value that encodes global and new reference - points (GREF and NREF). GREF and NREF are - specified by numbers as below: - - 0---1---2 -- ascent - | | - | | - | | - 9--10--11 -- center - | | - ---3---4---5--- baseline - | | - 6---7---8 -- descent - */ - int rule = COMPOSITION_RULE (cmp, i); - int gref, nref, grefx, grefy, nrefx, nrefy; - - COMPOSITION_DECODE_RULE (rule, gref, nref); - grefx = gref % 3, nrefx = nref % 3; - grefy = gref / 3, nrefy = nref / 3; - - left = (leftmost - + grefx * (rightmost - leftmost) / 2 - - nrefx * width / 2); - btm = ((grefy == 0 ? highest - : grefy == 1 ? 0 - : grefy == 2 ? lowest - : (highest + lowest) / 2) - - (nrefy == 0 ? ascent + descent - : nrefy == 1 ? descent - boff - : nrefy == 2 ? 0 - : (ascent + descent) / 2)); - } - - cmp->offsets[i * 2] = left; - cmp->offsets[i * 2 + 1] = btm + descent; - - /* Update the bounding box of the overall glyphs. */ - right = left + width; - top = btm + descent + ascent; - if (left < leftmost) - leftmost = left; - if (right > rightmost) - rightmost = right; - if (top > highest) - highest = top; - if (btm < lowest) - lowest = btm; } /* If there are glyphs whose x-offsets are negative, @@ -21059,6 +21338,21 @@ x_produce_glyphs (it) for (i = 0; i < cmp->glyph_len; i++) cmp->offsets[i * 2] -= leftmost; rightmost -= leftmost; + cmp->lbearing -= leftmost; + cmp->rbearing -= leftmost; + } + + if (left_padded && cmp->lbearing < 0) + { + for (i = 0; i < cmp->glyph_len; i++) + cmp->offsets[i * 2] -= cmp->lbearing; + rightmost -= cmp->lbearing; + cmp->rbearing -= cmp->lbearing; + cmp->lbearing = 0; + } + if (right_padded && rightmost < cmp->rbearing) + { + rightmost = cmp->rbearing; } cmp->pixel_width = rightmost; @@ -21070,6 +21364,11 @@ x_produce_glyphs (it) cmp->descent = font_descent; } + if (it->glyph_row + && (cmp->lbearing < 0 + || cmp->rbearing > cmp->pixel_width)) + it->glyph_row->contains_overlapping_glyphs_p = 1; + it->pixel_width = cmp->pixel_width; it->ascent = it->phys_ascent = cmp->ascent; it->descent = it->phys_descent = cmp->descent; @@ -21180,7 +21479,8 @@ x_insert_glyphs (start, len) int line_height, shift_by_width, shifted_region_width; struct glyph_row *row; struct glyph *glyph; - int frame_x, frame_y, hpos; + int frame_x, frame_y; + EMACS_INT hpos; xassert (updated_window && updated_row); BLOCK_INPUT; @@ -22138,7 +22438,7 @@ cursor_in_mouse_face_p (w) static int fast_find_position (w, charpos, hpos, vpos, x, y, stop) struct window *w; - int charpos; + EMACS_INT charpos; int *hpos, *vpos, *x, *y; Lisp_Object stop; { @@ -22226,7 +22526,7 @@ fast_find_position (w, charpos, hpos, vpos, x, y, stop) static int fast_find_position (w, pos, hpos, vpos, x, y, stop) struct window *w; - int pos; + EMACS_INT pos; int *hpos, *vpos, *x, *y; Lisp_Object stop; { @@ -22340,7 +22640,7 @@ fast_find_position (w, pos, hpos, vpos, x, y, stop) static int fast_find_string_pos (w, pos, object, hpos, vpos, x, y, right_p) struct window *w; - int pos; + EMACS_INT pos; Lisp_Object object; int *hpos, *vpos, *x, *y; int right_p; @@ -23501,10 +23801,11 @@ expose_line (w, row, r) LAST_OVERLAPPING_ROW is the last such row. */ static void -expose_overlaps (w, first_overlapping_row, last_overlapping_row) +expose_overlaps (w, first_overlapping_row, last_overlapping_row, r) struct window *w; struct glyph_row *first_overlapping_row; struct glyph_row *last_overlapping_row; + XRectangle *r; { struct glyph_row *row; @@ -23513,6 +23814,7 @@ expose_overlaps (w, first_overlapping_row, last_overlapping_row) { xassert (row->enabled_p && !row->mode_line_p); + row->clip = r; if (row->used[LEFT_MARGIN_AREA]) x_fix_overlapping_area (w, row, LEFT_MARGIN_AREA, OVERLAPS_BOTH); @@ -23521,6 +23823,7 @@ expose_overlaps (w, first_overlapping_row, last_overlapping_row) if (row->used[RIGHT_MARGIN_AREA]) x_fix_overlapping_area (w, row, RIGHT_MARGIN_AREA, OVERLAPS_BOTH); + row->clip = NULL; } } @@ -23704,8 +24007,22 @@ expose_window (w, fr) last_overlapping_row = row; } + row->clip = fr; if (expose_line (w, row, &r)) mouse_face_overwritten_p = 1; + row->clip = NULL; + } + else if (row->overlapping_p) + { + /* We must redraw a row overlapping the exposed area. */ + if (y0 < r.y + ? y0 + row->phys_height > r.y + : y0 + row->ascent - row->phys_ascent < r.y +r.height) + { + if (first_overlapping_row == NULL) + first_overlapping_row = row; + last_overlapping_row = row; + } } if (y1 >= yb) @@ -23726,7 +24043,8 @@ expose_window (w, fr) { /* Fix the display of overlapping rows. */ if (first_overlapping_row) - expose_overlaps (w, first_overlapping_row, last_overlapping_row); + expose_overlaps (w, first_overlapping_row, last_overlapping_row, + fr); /* Draw border between windows. */ x_draw_vertical_border (w); diff --git a/src/xfaces.c b/src/xfaces.c index c4b19c71bb1..853a3867f63 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -56,7 +56,7 @@ Boston, MA 02110-1301, USA. */ 13. Whether or not a box should be drawn around characters, the box type, and, for simple boxes, in what color. - 14. Font or fontset pattern, or nil. This is a special attribute. + 14. Font pattern, or nil. This is a special attribute. When this attribute is specified, the face uses a font opened by that pattern as is. In addition, all the other font-related attributes (1st thru 5th) are generated from the opened font name. @@ -72,6 +72,8 @@ Boston, MA 02110-1301, USA. */ and is used to ensure that a font specified on the command line, for example, can be matched exactly. + 17. A fontset name. + Faces are frame-local by nature because Emacs allows to define the same named face (face names are symbols) differently for different frames. Each frame has an alist of face definitions for all named @@ -123,7 +125,7 @@ Boston, MA 02110-1301, USA. */ is realized, it inherits (thus shares) a fontset of an ASCII face that has the same attributes other than font-related ones. - Thus, all realized face have a realized fontset. + Thus, all realized faces have a realized fontset. Unibyte text. @@ -198,6 +200,7 @@ Boston, MA 02110-1301, USA. */ #include <stdio.h> /* This needs to be before termchar.h */ #include "lisp.h" +#include "character.h" #include "charset.h" #include "keyboard.h" #include "frame.h" @@ -246,6 +249,10 @@ Boston, MA 02110-1301, USA. */ #include "intervals.h" #include "termchar.h" +#ifdef HAVE_WINDOW_SYSTEM +#include "font.h" +#endif /* HAVE_WINDOW_SYSTEM */ + #ifdef HAVE_X_WINDOWS /* Compensate for a bug in Xos.h on some systems, on which it requires @@ -305,6 +312,7 @@ Lisp_Object QCinverse_video, QCforeground, QCbackground, QCstipple; Lisp_Object QCwidth, QCfont, QCbold, QCitalic; Lisp_Object QCreverse_video; Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit; +Lisp_Object QCfontset; /* Symbols used for attribute values. */ @@ -488,7 +496,7 @@ static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *)); static unsigned char *xstrlwr P_ ((unsigned char *)); static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int)); -static void load_face_font P_ ((struct frame *, struct face *, int)); +static void load_face_font P_ ((struct frame *, struct face *)); static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *)); static void free_face_colors P_ ((struct frame *, struct face *)); static int face_color_gray_p P_ ((struct frame *, char *)); @@ -501,18 +509,17 @@ static int font_list_1 P_ ((struct frame *, Lisp_Object, Lisp_Object, Lisp_Object, struct font_name **)); static int font_list P_ ((struct frame *, Lisp_Object, Lisp_Object, Lisp_Object, struct font_name **)); -static int try_font_list P_ ((struct frame *, Lisp_Object *, - Lisp_Object, Lisp_Object, struct font_name **, - int)); +static int try_font_list P_ ((struct frame *, Lisp_Object, + Lisp_Object, Lisp_Object, struct font_name **)); static int try_alternative_families P_ ((struct frame *f, Lisp_Object, Lisp_Object, struct font_name **)); static int cmp_font_names P_ ((const void *, const void *)); -static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *, int, - struct face *, int)); -static struct face *realize_x_face P_ ((struct face_cache *, - Lisp_Object *, int, struct face *)); -static struct face *realize_tty_face P_ ((struct face_cache *, - Lisp_Object *, int)); +static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *, + int)); +static struct face *realize_non_ascii_face P_ ((struct frame *, int, + struct face *)); +static struct face *realize_x_face P_ ((struct face_cache *, Lisp_Object *)); +static struct face *realize_tty_face P_ ((struct face_cache *, Lisp_Object *)); static int realize_basic_faces P_ ((struct frame *)); static int realize_default_face P_ ((struct frame *)); static void realize_named_face P_ ((struct frame *, Lisp_Object, int)); @@ -522,23 +529,22 @@ static unsigned hash_string_case_insensitive P_ ((Lisp_Object)); static unsigned lface_hash P_ ((Lisp_Object *)); static int lface_same_font_attributes_p P_ ((Lisp_Object *, Lisp_Object *)); static struct face_cache *make_face_cache P_ ((struct frame *)); -static void free_realized_face P_ ((struct frame *, struct face *)); static void clear_face_gcs P_ ((struct face_cache *)); static void free_face_cache P_ ((struct face_cache *)); static int face_numeric_weight P_ ((Lisp_Object)); static int face_numeric_slant P_ ((Lisp_Object)); static int face_numeric_swidth P_ ((Lisp_Object)); static int face_fontset P_ ((Lisp_Object *)); -static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int, int*)); static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*, struct named_merge_point *)); static int merge_face_ref P_ ((struct frame *, Lisp_Object, Lisp_Object *, int, struct named_merge_point *)); static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object, Lisp_Object, int, int)); +static void set_lface_from_font_and_fontset P_ ((struct frame *, Lisp_Object, + Lisp_Object, int, int)); static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int)); static struct face *make_realized_face P_ ((Lisp_Object *)); -static void free_realized_faces P_ ((struct face_cache *)); static char *best_matching_font P_ ((struct frame *, Lisp_Object *, struct font_name *, int, int, int *)); static void cache_face P_ ((struct face_cache *, struct face *, unsigned)); @@ -973,6 +979,9 @@ clear_face_cache (clear_fonts_p) { struct x_display_info *dpyinfo; +#ifdef USE_FONT_BACKEND + if (! enable_font_backend) +#endif /* USE_FONT_BACKEND */ /* Fonts are common for frames on one display, i.e. on one X screen. */ for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) @@ -1219,30 +1228,32 @@ load_pixmap (f, name, w_ptr, h_ptr) #ifdef HAVE_WINDOW_SYSTEM -/* Load font of face FACE which is used on frame F to display - character C. The name of the font to load is determined by lface - and fontset of FACE. */ +/* Load font of face FACE which is used on frame F to display ASCII + characters. The name of the font to load is determined by lface. */ static void -load_face_font (f, face, c) +load_face_font (f, face) struct frame *f; struct face *face; - int c; { struct font_info *font_info = NULL; char *font_name; int needs_overstrike; +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + abort (); +#endif /* USE_FONT_BACKEND */ face->font_info_id = -1; face->font = NULL; + face->font_name = NULL; - font_name = choose_face_font (f, face->lface, face->fontset, c, - &needs_overstrike); + font_name = choose_face_font (f, face->lface, Qnil, &needs_overstrike); if (!font_name) return; BLOCK_INPUT; - font_info = FS_LOAD_FACE_FONT (f, c, font_name, face); + font_info = FS_LOAD_FONT (f, font_name); UNBLOCK_INPUT; if (font_info) @@ -1383,7 +1394,7 @@ tty_defined_color (f, color_name, color_def, alloc) color_def->green = 0; if (*color_name) - status = tty_lookup_color (f, build_string (color_name), color_def, 0); + status = tty_lookup_color (f, build_string (color_name), color_def, NULL); if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name) { @@ -2127,7 +2138,7 @@ face_value (table, dim, symbol) static INLINE int face_numeric_value (table, dim, symbol) struct table_entry *table; - int dim; + size_t dim; Lisp_Object symbol; { struct table_entry *p = face_value (table, dim, symbol); @@ -2168,9 +2179,117 @@ face_numeric_swidth (width) return face_numeric_value (swidth_table, DIM (swidth_table), width); } - #ifdef HAVE_WINDOW_SYSTEM +#ifdef USE_FONT_BACKEND +static INLINE Lisp_Object +face_symbolic_value (table, dim, font_prop) + struct table_entry *table; + int dim; + Lisp_Object font_prop; +{ + struct table_entry *p; + char *s = SDATA (SYMBOL_NAME (font_prop)); + int low, mid, high, cmp; + + low = 0; + high = dim - 1; + + while (low <= high) + { + mid = (low + high) / 2; + cmp = strcmp (table[mid].name, s); + + if (cmp < 0) + low = mid + 1; + else if (cmp > 0) + high = mid - 1; + else + return *table[mid].symbol; + } + + return Qnil; +} + +static INLINE Lisp_Object +face_symbolic_weight (weight) + Lisp_Object weight; +{ + return face_symbolic_value (weight_table, DIM (weight_table), weight); +} + +static INLINE Lisp_Object +face_symbolic_slant (slant) + Lisp_Object slant; +{ + return face_symbolic_value (slant_table, DIM (slant_table), slant); +} + +static INLINE Lisp_Object +face_symbolic_swidth (width) + Lisp_Object width; +{ + return face_symbolic_value (swidth_table, DIM (swidth_table), width); +} +#endif /* USE_FONT_BACKEND */ + +Lisp_Object +split_font_name_into_vector (fontname) + Lisp_Object fontname; +{ + struct font_name font; + Lisp_Object vec; + int i; + + font.name = LSTRDUPA (fontname); + if (! split_font_name (NULL, &font, 0)) + return Qnil; + vec = Fmake_vector (make_number (XLFD_LAST), Qnil); + for (i = 0; i < XLFD_LAST; i++) + if (font.fields[i][0] != '*') + ASET (vec, i, build_string (font.fields[i])); + return vec; +} + +Lisp_Object +build_font_name_from_vector (vec) + Lisp_Object vec; +{ + struct font_name font; + Lisp_Object fontname; + char *p; + int i; + + for (i = 0; i < XLFD_LAST; i++) + { + font.fields[i] = (NILP (AREF (vec, i)) + ? "*" : (char *) SDATA (AREF (vec, i))); + if ((i == XLFD_FAMILY || i == XLFD_REGISTRY) + && (p = strchr (font.fields[i], '-'))) + { + char *p1 = STRDUPA (font.fields[i]); + + p1[p - font.fields[i]] = '\0'; + if (i == XLFD_FAMILY) + { + font.fields[XLFD_FOUNDRY] = p1; + font.fields[XLFD_FAMILY] = p + 1; + } + else + { + font.fields[XLFD_REGISTRY] = p1; + font.fields[XLFD_ENCODING] = p + 1; + break; + } + } + } + + p = build_font_name (&font); + fontname = build_string (p); + xfree (p); + return fontname; +} + /* Return non-zero if FONT is the name of a fixed-pitch font. */ static INLINE int @@ -2193,7 +2312,9 @@ xlfd_fixed_p (font) 72dpi versions, only.) Value is the real point size of FONT on frame F, or 0 if it cannot - be determined. */ + be determined. + + By side effect, set FONT->numeric[XLFD_PIXEL_SIZE]. */ static INLINE int xlfd_point_size (f, font) @@ -2232,6 +2353,7 @@ xlfd_point_size (f, font) else pixel = atoi (pixel_field); + font->numeric[XLFD_PIXEL_SIZE] = pixel; if (pixel == 0) real_pt = 0; else @@ -2718,12 +2840,12 @@ cmp_font_names (a, b) } -/* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN - is non-nil list fonts matching that pattern. Otherwise, if - REGISTRY is non-nil return only fonts with that registry, otherwise - return fonts of any registry. Set *FONTS to a vector of font_name - structures allocated from the heap containing the fonts found. - Value is the number of fonts found. */ +/* Get a sorted list of fonts matching PATTERN on frame F. If PATTERN + is nil, list fonts matching FAMILY and REGISTRY. FAMILY is a + family name string or nil. REGISTRY is a registry name string. + Set *FONTS to a vector of font_name structures allocated from the + heap containing the fonts found. Value is the number of fonts + found. */ static int font_list_1 (f, pattern, family, registry, fonts) @@ -2784,10 +2906,11 @@ concat_font_list (fonts1, nfonts1, fonts2, nfonts2) /* Get a sorted list of fonts of family FAMILY on frame F. - If PATTERN is non-nil list fonts matching that pattern. + If PATTERN is non-nil, list fonts matching that pattern. - If REGISTRY is non-nil, return fonts with that registry and the - alternative registries from Vface_alternative_font_registry_alist. + If REGISTRY is non-nil, it is a list of registry (and encoding) + names. Return fonts with those registries and the alternative + registries from Vface_alternative_font_registry_alist. If REGISTRY is nil return fonts of any registry. @@ -2801,35 +2924,37 @@ font_list (f, pattern, family, registry, fonts) Lisp_Object pattern, family, registry; struct font_name **fonts; { - int nfonts = font_list_1 (f, pattern, family, registry, fonts); + int nfonts; + int reg_prio; + int i; + + if (NILP (registry)) + return font_list_1 (f, pattern, family, registry, fonts); - if (!NILP (registry) - && CONSP (Vface_alternative_font_registry_alist)) + for (reg_prio = 0, nfonts = 0; CONSP (registry); registry = XCDR (registry)) { - Lisp_Object alter; + Lisp_Object elt, alter; + int nfonts2; + struct font_name *fonts2; - alter = Fassoc (registry, Vface_alternative_font_registry_alist); - if (CONSP (alter)) + elt = XCAR (registry); + alter = Fassoc (elt, Vface_alternative_font_registry_alist); + if (NILP (alter)) + alter = Fcons (elt, Qnil); + for (; CONSP (alter); alter = XCDR (alter), reg_prio++) { - int reg_prio, i; - - for (alter = XCDR (alter), reg_prio = 1; - CONSP (alter); - alter = XCDR (alter), reg_prio++) - if (STRINGP (XCAR (alter))) - { - int nfonts2; - struct font_name *fonts2; - - nfonts2 = font_list_1 (f, pattern, family, XCAR (alter), - &fonts2); + nfonts2 = font_list_1 (f, pattern, family, XCAR (alter), &fonts2); + if (nfonts2 > 0) + { + if (reg_prio > 0) for (i = 0; i < nfonts2; i++) fonts2[i].registry_priority = reg_prio; - *fonts = (nfonts > 0 - ? concat_font_list (*fonts, nfonts, fonts2, nfonts2) - : fonts2); - nfonts += nfonts2; - } + if (nfonts > 0) + *fonts = concat_font_list (*fonts, nfonts, fonts2, nfonts2); + else + *fonts = fonts2; + nfonts += nfonts2; + } } } @@ -3011,18 +3136,11 @@ the WIDTH times as wide as FACE on FRAME. */) { /* This is of limited utility since it works with character widths. Keep it for compatibility. --gerd. */ - int face_id = lookup_named_face (f, face, 0, 0); + int face_id = lookup_named_face (f, face, 0); struct face *face = (face_id < 0 ? NULL : FACE_FROM_ID (f, face_id)); -#ifdef WINDOWSNT -/* For historic reasons, FONT_WIDTH refers to average width on W32, - not maximum as on X. Redefine here. */ -#undef FONT_WIDTH -#define FONT_WIDTH FONT_MAX_WIDTH -#endif - if (face && face->font) size = FONT_WIDTH (face->font); else @@ -3070,6 +3188,7 @@ the WIDTH times as wide as FACE on FRAME. */) #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX) #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX) #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX) +#define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX) /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */ @@ -3148,7 +3267,12 @@ check_lface_attrs (attrs) xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX]) || IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX]) || NILP (attrs[LFACE_FONT_INDEX]) +#ifdef USE_FONT_BACKEND + || FONT_OBJECT_P (attrs[LFACE_FONT_INDEX]) +#endif /* USE_FONT_BACKEND */ || STRINGP (attrs[LFACE_FONT_INDEX])); + xassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX]) + || STRINGP (attrs[LFACE_FONTSET_INDEX])); #endif } @@ -3356,7 +3480,7 @@ lface_fully_specified_p (attrs) for (i = 1; i < LFACE_VECTOR_SIZE; ++i) if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX - && i != LFACE_AVGWIDTH_INDEX) + && i != LFACE_AVGWIDTH_INDEX && i != LFACE_FONTSET_INDEX) if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i])) #ifdef MAC_OS /* MAC_TODO: No stipple support on Mac OS yet, this index is @@ -3400,8 +3524,15 @@ set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p) /* If FONTNAME is actually a fontset name, get ASCII font name of it. */ fontset = fs_query_fontset (fontname, 0); - if (fontset >= 0) + + if (fontset > 0) font_name = SDATA (fontset_ascii (fontset)); + else if (fontset == 0) + { + if (may_fail_p) + return 0; + abort (); + } /* Check if FONT_NAME is surely available on the system. Usually FONT_NAME is already cached for the frame F and FS_LOAD_FONT @@ -3409,7 +3540,7 @@ set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p) caching it now is not futail because we anyway load the font later. */ BLOCK_INPUT; - font_info = FS_LOAD_FONT (f, 0, font_name, -1); + font_info = FS_LOAD_FONT (f, font_name); UNBLOCK_INPUT; if (!font_info) @@ -3471,11 +3602,103 @@ set_lface_from_font_name (f, lface, fontname, force_p, may_fail_p) LFACE_SLANT (lface) = have_xlfd_p ? xlfd_symbolic_slant (&font) : Qnormal; - LFACE_FONT (lface) = fontname; - + if (fontset > 0) + { + LFACE_FONT (lface) = build_string (font_info->full_name); + LFACE_FONTSET (lface) = fontset_name (fontset); + } + else + { + LFACE_FONT (lface) = fontname; + fontset + = new_fontset_from_font_name (build_string (font_info->full_name)); + LFACE_FONTSET (lface) = fontset_name (fontset); + } return 1; } +#ifdef USE_FONT_BACKEND +/* Set font-related attributes of Lisp face LFACE from FONT-OBJECT and + FONTSET. If FORCE_P is zero, set only unspecified attributes of + LFACE. The exceptions are `font' and `fontset' attributes. They + are set regardless of FORCE_P. */ + +static void +set_lface_from_font_and_fontset (f, lface, font_object, fontset, force_p) + struct frame *f; + Lisp_Object lface, font_object; + int fontset; + int force_p; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + Lisp_Object entity = font->entity; + Lisp_Object val; + + /* Set attributes only if unspecified, otherwise face defaults for + new frames would never take effect. If the font doesn't have a + specific property, set a normal value for that. */ + + if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface))) + { + Lisp_Object foundry = AREF (entity, FONT_FOUNDRY_INDEX); + Lisp_Object family = AREF (entity, FONT_FAMILY_INDEX); + + if (! NILP (foundry)) + { + if (! NILP (family)) + val = concat3 (SYMBOL_NAME (foundry), build_string ("-"), + SYMBOL_NAME (family)); + else + val = concat2 (SYMBOL_NAME (foundry), build_string ("-*")); + } + else + { + if (! NILP (family)) + val = SYMBOL_NAME (family); + else + val = build_string ("*"); + } + LFACE_FAMILY (lface) = val; + } + + if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface))) + { + int pt = pixel_point_size (f, font->pixel_size * 10); + + xassert (pt > 0); + LFACE_HEIGHT (lface) = make_number (pt); + } + + if (force_p || UNSPECIFIEDP (LFACE_AVGWIDTH (lface))) + LFACE_AVGWIDTH (lface) = make_number (font->font.average_width); + + if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface))) + { + Lisp_Object weight = font_symbolic_weight (entity); + + val = NILP (weight) ? Qnormal : face_symbolic_weight (weight); + LFACE_WEIGHT (lface) = ! NILP (val) ? val : weight; + } + if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface))) + { + Lisp_Object slant = font_symbolic_slant (entity); + + val = NILP (slant) ? Qnormal : face_symbolic_slant (slant); + LFACE_SLANT (lface) = ! NILP (val) ? val : slant; + } + if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface))) + { + Lisp_Object width = font_symbolic_width (entity); + + val = NILP (width) ? Qnormal : face_symbolic_swidth (width); + LFACE_SWIDTH (lface) = ! NILP (val) ? val : width; + } + + LFACE_FONT (lface) = font_object; + LFACE_FONTSET (lface) = fontset_name (fontset); +} +#endif /* USE_FONT_BACKEND */ + #endif /* HAVE_WINDOW_SYSTEM */ @@ -4300,7 +4523,7 @@ FRAME 0 means change the face on all frames, and change the default LFACE_SWIDTH (lface) = value; font_related_attr_p = 1; } - else if (EQ (attr, QCfont)) + else if (EQ (attr, QCfont) || EQ (attr, QCfontset)) { #ifdef HAVE_WINDOW_SYSTEM if (EQ (frame, Qt) || FRAME_WINDOW_P (XFRAME (frame))) @@ -4315,6 +4538,48 @@ FRAME 0 means change the face on all frames, and change the default else f = check_x_frame (frame); +#ifdef USE_FONT_BACKEND + if (enable_font_backend + && !UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) + { + int fontset; + + if (EQ (attr, QCfontset)) + { + Lisp_Object fontset_name = Fquery_fontset (value, Qnil); + + if (NILP (fontset_name)) + signal_error ("Invalid fontset name", value); + LFACE_FONTSET (lface) = value; + } + else + { + Lisp_Object font_object; + + if (FONT_OBJECT_P (value)) + { + font_object = value; + fontset = FRAME_FONTSET (f); + } + else + { + CHECK_STRING (value); + + fontset = fs_query_fontset (value, 0); + if (fontset >= 0) + value = fontset_ascii (fontset); + else + fontset = FRAME_FONTSET (f); + font_object = font_open_by_name (f, SDATA (value)); + if (NILP (font_object)) + signal_error ("Invalid font", value); + } + set_lface_from_font_and_fontset (f, lface, font_object, + fontset, 1); + } + } + else +#endif /* USE_FONT_BACKEND */ if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value)) { CHECK_STRING (value); @@ -4324,9 +4589,16 @@ FRAME 0 means change the face on all frames, and change the default tmp = Fquery_fontset (value, Qnil); if (!NILP (tmp)) value = tmp; + else if (EQ (attr, QCfontset)) + signal_error ("Invalid fontset name", value); - if (!set_lface_from_font_name (f, lface, value, 1, 1)) - signal_error ("Invalid font or fontset name", value); + if (EQ (attr, QCfont)) + { + if (!set_lface_from_font_name (f, lface, value, 1, 1)) + signal_error ("Invalid font or fontset name", value); + } + else + LFACE_FONTSET (lface) = value; } font_attr_p = 1; @@ -4378,6 +4650,7 @@ FRAME 0 means change the face on all frames, and change the default if (!EQ (frame, Qt) && NILP (Fget (face, Qface_no_inherit)) && (EQ (attr, QCfont) + || EQ (attr, QCfontset) || NILP (Fequal (old_value, value)))) { ++face_change_count; @@ -4485,7 +4758,7 @@ FRAME 0 means change the face on all frames, and change the default #ifdef HAVE_WINDOW_SYSTEM /* Set the `font' frame parameter of FRAME determined from `default' - face attributes LFACE. If a face or fontset name is explicitely + face attributes LFACE. If a font name is explicitely specfied in LFACE, use it as is. Otherwise, determine a font name from the other font-related atrributes of LFACE. In that case, if there's no matching font, signals an error. */ @@ -4503,12 +4776,30 @@ set_font_frame_param (frame, lface) if (STRINGP (LFACE_FONT (lface))) font_name = LFACE_FONT (lface); +#ifdef USE_FONT_BACKEND + else if (enable_font_backend) + { + /* We set FONT_NAME to a font-object. */ + if (FONT_OBJECT_P (LFACE_FONT (lface))) + font_name = LFACE_FONT (lface); + else + { + font_name = font_find_for_lface (f, &AREF (lface, 0), Qnil, -1); + if (NILP (font_name)) + error ("No font matches the specified attribute"); + font_name = font_open_for_lface (f, font_name, &AREF (lface, 0), + Qnil); + if (NILP (font_name)) + error ("No font matches the specified attribute"); + } + } +#endif else { /* Choose a font name that reflects LFACE's attributes and has the registry and encoding pattern specified in the default fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */ - font = choose_face_font (f, XVECTOR (lface)->contents, -1, 0, 0); + font = choose_face_font (f, XVECTOR (lface)->contents, Qnil, NULL); if (!font) error ("No font matches the specified attribute"); font_name = build_string (font); @@ -4891,6 +5182,8 @@ frames). If FRAME is omitted or nil, use the selected frame. */) value = LFACE_INHERIT (lface); else if (EQ (keyword, QCfont)) value = LFACE_FONT (lface); + else if (EQ (keyword, QCfontset)) + value = LFACE_FONTSET (lface); else signal_error ("Invalid face attribute name", keyword); @@ -4995,15 +5288,18 @@ Default face attributes override any local face attributes. */) return fonts with the same size as the font of a face. This is done in fontset.el. */ -DEFUN ("face-font", Fface_font, Sface_font, 1, 2, 0, +DEFUN ("face-font", Fface_font, Sface_font, 1, 3, 0, doc: /* Return the font name of face FACE, or nil if it is unspecified. +The font name is, by default, for ASCII characters. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). The font default for a face is either nil, or a list of the form (bold), (italic) or (bold italic). -If FRAME is omitted or nil, use the selected frame. */) - (face, frame) - Lisp_Object face, frame; +If FRAME is omitted or nil, use the selected frame. And, in this case, +if the optional third argument CHARACTER is given, +return the font name used for CHARACTER. */) + (face, frame, character) + Lisp_Object face, frame, character; { if (EQ (frame, Qt)) { @@ -5023,9 +5319,23 @@ If FRAME is omitted or nil, use the selected frame. */) else { struct frame *f = frame_or_selected_frame (frame, 1); - int face_id = lookup_named_face (f, face, 0, 1); + int face_id = lookup_named_face (f, face, 1); struct face *face = FACE_FROM_ID (f, face_id); - return face ? build_string (face->font_name) : Qnil; + + if (! face) + return Qnil; +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f) && !NILP (character)) + { + CHECK_CHARACTER (character); + face_id = FACE_FOR_CHAR (f, face, XINT (character), -1, Qnil); + face = FACE_FROM_ID (f, face_id); + return (face->font && face->font_name + ? build_string (face->font_name) + : Qnil); + } +#endif + return build_string (face->font_name); } } @@ -5188,8 +5498,8 @@ lface_hash (v) /* Return non-zero if LFACE1 and LFACE2 specify the same font (without considering charsets/registries). They do if they specify the same - family, point size, weight, width, slant, and fontset. Both LFACE1 - and LFACE2 must be fully-specified. */ + family, point size, weight, width, slant, font, and fontset. Both + LFACE1 and LFACE2 must be fully-specified. */ static INLINE int lface_same_font_attributes_p (lface1, lface2) @@ -5207,8 +5517,14 @@ lface_same_font_attributes_p (lface1, lface2) && (EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX]) || (STRINGP (lface1[LFACE_FONT_INDEX]) && STRINGP (lface2[LFACE_FONT_INDEX]) - && xstricmp (SDATA (lface1[LFACE_FONT_INDEX]), - SDATA (lface2[LFACE_FONT_INDEX]))))); + && ! xstricmp (SDATA (lface1[LFACE_FONT_INDEX]), + SDATA (lface2[LFACE_FONT_INDEX])))) + && (EQ (lface1[LFACE_FONTSET_INDEX], lface2[LFACE_FONTSET_INDEX]) + || (STRINGP (lface1[LFACE_FONTSET_INDEX]) + && STRINGP (lface2[LFACE_FONTSET_INDEX]) + && ! xstricmp (SDATA (lface1[LFACE_FONTSET_INDEX]), + SDATA (lface2[LFACE_FONTSET_INDEX])))) + ); } @@ -5235,7 +5551,7 @@ make_realized_face (attr) /* Free realized face FACE, including its X resources. FACE may be null. */ -static void +void free_realized_face (f, face) struct frame *f; struct face *face; @@ -5251,6 +5567,10 @@ free_realized_face (f, face) if (face->gc) { BLOCK_INPUT; +#ifdef USE_FONT_BACKEND + if (enable_font_backend && face->font_info) + font_done_for_face (f, face); +#endif /* USE_FONT_BACKEND */ x_free_gc (f, face->gc); face->gc = 0; UNBLOCK_INPUT; @@ -5313,6 +5633,10 @@ prepare_face_for_display (f, face) } #endif face->gc = x_create_gc (f, mask, &xgcv); +#ifdef USE_FONT_BACKEND + if (enable_font_backend && face->font) + font_prepare_for_face (f, face); +#endif /* USE_FONT_BACKEND */ UNBLOCK_INPUT; } #endif /* HAVE_WINDOW_SYSTEM */ @@ -5418,6 +5742,10 @@ clear_face_gcs (c) if (face && face->gc) { BLOCK_INPUT; +#ifdef USE_FONT_BACKEND + if (enable_font_backend && face->font_info) + font_done_for_face (c->f, face); +#endif /* USE_FONT_BACKEND */ x_free_gc (c->f, face->gc); face->gc = 0; UNBLOCK_INPUT; @@ -5472,11 +5800,10 @@ free_realized_faces (c) } -/* Free all faces realized for multibyte characters on frame F that - has FONTSET. */ +/* Free all realized faces that are using FONTSET on frame F. */ void -free_realized_multibyte_face (f, fontset) +free_realized_faces_for_fontset (f, fontset) struct frame *f; int fontset; { @@ -5493,7 +5820,6 @@ free_realized_multibyte_face (f, fontset) { face = cache->faces_by_id[i]; if (face - && face != face->ascii_face && face->fontset == fontset) { uncache_face (cache, face); @@ -5551,10 +5877,11 @@ free_face_cache (c) /* Cache realized face FACE in face cache C. HASH is the hash value - of FACE. If FACE->fontset >= 0, add the new face to the end of the - collision list of the face hash table of C. This is done because - otherwise lookup_face would find FACE for every character, even if - faces with the same attributes but for specific characters exist. */ + of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face == + FACE), insert the new face to the beginning of the collision list + of the face hash table of C. Otherwise, add the new face to the + end of the collision list. This way, lookup_face can quickly find + that a requested face is not cached. */ static void cache_face (c, face, hash) @@ -5566,7 +5893,7 @@ cache_face (c, face, hash) face->hash = hash; - if (face->fontset >= 0) + if (face->ascii_face != face) { struct face *last = c->buckets[i]; if (last) @@ -5658,17 +5985,14 @@ uncache_face (c, face) /* Look up a realized face with face attributes ATTR in the face cache - of frame F. The face will be used to display character C. Value - is the ID of the face found. If no suitable face is found, realize - a new one. In that case, if C is a multibyte character, BASE_FACE - is a face that has the same attributes. */ + of frame F. The face will be used to display ASCII characters. + Value is the ID of the face found. If no suitable face is found, + realize a new one. */ INLINE int -lookup_face (f, attr, c, base_face) +lookup_face (f, attr) struct frame *f; Lisp_Object *attr; - int c; - struct face *base_face; { struct face_cache *cache = FRAME_FACE_CACHE (f); unsigned hash; @@ -5683,44 +6007,121 @@ lookup_face (f, attr, c, base_face) i = hash % FACE_CACHE_BUCKETS_SIZE; for (face = cache->buckets[i]; face; face = face->next) - if (face->hash == hash - && (!FRAME_WINDOW_P (f) - || FACE_SUITABLE_FOR_CHAR_P (face, c)) - && lface_equal_p (face->lface, attr)) - break; + { + if (face->ascii_face != face) + { + /* There's no more ASCII face. */ + face = NULL; + break; + } + if (face->hash == hash + && lface_equal_p (face->lface, attr)) + break; + } /* If not found, realize a new face. */ if (face == NULL) - face = realize_face (cache, attr, c, base_face, -1); + face = realize_face (cache, attr, -1); #if GLYPH_DEBUG xassert (face == FACE_FROM_ID (f, face->id)); +#endif /* GLYPH_DEBUG */ -/* When this function is called from face_for_char (in this case, C is - a multibyte character), a fontset of a face returned by - realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE, - C) is not sutisfied. The fontset is set for this face by - face_for_char later. */ -#if 0 - if (FRAME_WINDOW_P (f)) - xassert (FACE_SUITABLE_FOR_CHAR_P (face, c)); -#endif + return face->id; +} + +#ifdef HAVE_WINDOW_SYSTEM +/* Look up a realized face that has the same attributes as BASE_FACE + except for the font in the face cache of frame F. If FONT_ID is + not negative, it is an ID number of an already opened font that is + used by the face. If FONT_ID is negative, the face has no font. + Value is the ID of the face found. If no suitable face is found, + realize a new one. */ + +int +lookup_non_ascii_face (f, font_id, base_face) + struct frame *f; + int font_id; + struct face *base_face; +{ + struct face_cache *cache = FRAME_FACE_CACHE (f); + unsigned hash; + int i; + struct face *face; + + xassert (cache != NULL); + base_face = base_face->ascii_face; + hash = lface_hash (base_face->lface); + i = hash % FACE_CACHE_BUCKETS_SIZE; + + for (face = cache->buckets[i]; face; face = face->next) + { + if (face->ascii_face == face) + continue; + if (face->ascii_face == base_face + && face->font_info_id == font_id) + break; + } + + /* If not found, realize a new face. */ + if (face == NULL) + face = realize_non_ascii_face (f, font_id, base_face); + +#if GLYPH_DEBUG + xassert (face == FACE_FROM_ID (f, face->id)); #endif /* GLYPH_DEBUG */ return face->id; } +#ifdef USE_FONT_BACKEND +int +face_for_font (f, font, base_face) + struct frame *f; + struct font *font; + struct face *base_face; +{ + struct face_cache *cache = FRAME_FACE_CACHE (f); + unsigned hash; + int i; + struct face *face; + + xassert (cache != NULL); + base_face = base_face->ascii_face; + hash = lface_hash (base_face->lface); + i = hash % FACE_CACHE_BUCKETS_SIZE; + + for (face = cache->buckets[i]; face; face = face->next) + { + if (face->ascii_face == face) + continue; + if (face->ascii_face == base_face + && face->font == font->font.font + && face->font_info == (struct font_info *) font) + return face->id; + } + + /* If not found, realize a new face. */ + face = realize_non_ascii_face (f, -1, base_face); + face->font = font->font.font; + face->font_info = (struct font_info *) font; + face->font_info_id = 0; + face->font_name = font->font.full_name; + return face->id; +} +#endif /* USE_FONT_BACKEND */ + +#endif /* HAVE_WINDOW_SYSTEM */ /* Return the face id of the realized face for named face SYMBOL on - frame F suitable for displaying character C. Value is -1 if the - face couldn't be determined, which might happen if the default face - isn't realized and cannot be realized. */ + frame F suitable for displaying ASCII characters. Value is -1 if + the face couldn't be determined, which might happen if the default + face isn't realized and cannot be realized. */ int -lookup_named_face (f, symbol, c, signal_p) +lookup_named_face (f, symbol, signal_p) struct frame *f; Lisp_Object symbol; - int c; int signal_p; { Lisp_Object attrs[LFACE_VECTOR_SIZE]; @@ -5742,7 +6143,7 @@ lookup_named_face (f, symbol, c, signal_p) bcopy (default_face->lface, attrs, sizeof attrs); merge_face_vectors (f, symbol_attrs, attrs, 0); - return lookup_face (f, attrs, c, NULL); + return lookup_face (f, attrs); } @@ -5759,7 +6160,7 @@ ascii_face_of_lisp_face (f, lface_id) if (lface_id >= 0 && lface_id < lface_id_to_name_size) { Lisp_Object face_name = lface_id_to_name[lface_id]; - face_id = lookup_named_face (f, face_name, 0, 1); + face_id = lookup_named_face (f, face_name, 1); } else face_id = -1; @@ -5807,7 +6208,7 @@ smaller_face (f, face_id, steps) /* Look up a face for a slightly smaller/larger font. */ pt += delta; attrs[LFACE_HEIGHT_INDEX] = make_number (pt); - new_face_id = lookup_face (f, attrs, 0, NULL); + new_face_id = lookup_face (f, attrs); new_face = FACE_FROM_ID (f, new_face_id); /* If height changes, count that as one step. */ @@ -5850,7 +6251,7 @@ face_with_height (f, face_id, height) face = FACE_FROM_ID (f, face_id); bcopy (face->lface, attrs, sizeof attrs); attrs[LFACE_HEIGHT_INDEX] = make_number (height); - face_id = lookup_face (f, attrs, 0, NULL); + face_id = lookup_face (f, attrs); #endif /* HAVE_WINDOW_SYSTEM */ return face_id; @@ -5858,17 +6259,16 @@ face_with_height (f, face_id, height) /* Return the face id of the realized face for named face SYMBOL on - frame F suitable for displaying character C, and use attributes of - the face FACE_ID for attributes that aren't completely specified by - SYMBOL. This is like lookup_named_face, except that the default - attributes come from FACE_ID, not from the default face. FACE_ID - is assumed to be already realized. */ + frame F suitable for displaying ASCII characters, and use + attributes of the face FACE_ID for attributes that aren't + completely specified by SYMBOL. This is like lookup_named_face, + except that the default attributes come from FACE_ID, not from the + default face. FACE_ID is assumed to be already realized. */ int -lookup_derived_face (f, symbol, c, face_id, signal_p) +lookup_derived_face (f, symbol, face_id, signal_p) struct frame *f; Lisp_Object symbol; - int c; int face_id; int signal_p; { @@ -5882,7 +6282,7 @@ lookup_derived_face (f, symbol, c, face_id, signal_p) get_lface_attributes (f, symbol, symbol_attrs, signal_p); bcopy (default_face->lface, attrs, sizeof attrs); merge_face_vectors (f, symbol_attrs, attrs, 0); - return lookup_face (f, attrs, c, default_face); + return lookup_face (f, attrs); } DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector, @@ -5969,6 +6369,7 @@ x_supports_face_attributes_p (f, attrs, def_face) || !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX]) || !UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX])) { + int face_id; struct face *face; Lisp_Object merged_attrs[LFACE_VECTOR_SIZE]; @@ -5976,7 +6377,8 @@ x_supports_face_attributes_p (f, attrs, def_face) merge_face_vectors (f, attrs, merged_attrs, 0); - face = FACE_FROM_ID (f, lookup_face (f, merged_attrs, 0, 0)); + face_id = lookup_face (f, merged_attrs); + face = FACE_FROM_ID (f, face_id); if (! face) error ("Cannot make face"); @@ -6258,7 +6660,7 @@ face for italic. */) Font selection ***********************************************************************/ -DEFUN ("internal-set-font-selection-order", + DEFUN ("internal-set-font-selection-order", Finternal_set_font_selection_order, Sinternal_set_font_selection_order, 1, 1, 0, doc: /* Set font selection order for face font selection to ORDER. @@ -6314,6 +6716,10 @@ Value is ORDER. */) free_all_realized_faces (Qnil); } +#ifdef USE_FONT_BACKEND + font_update_sort_order (font_sort_order); +#endif /* USE_FONT_BACKEND */ + return Qnil; } @@ -6504,6 +6910,12 @@ build_scalable_font_name (f, font, specified_pt) double resy = FRAME_X_DISPLAY_INFO (f)->resy; double pt; + if (font->numeric[XLFD_PIXEL_SIZE] != 0 + || font->numeric[XLFD_POINT_SIZE] != 0) + /* This is a scalable font but is requested for a specific size. + We should not change that size. */ + return build_font_name (font); + /* If scalable font is for a specific resolution, compute the point size we must specify from the resolution of the display and the specified resolution of the font. */ @@ -6776,78 +7188,62 @@ try_alternative_families (f, family, registry, fonts) /* Get a list of matching fonts on frame F. - FAMILY, if a string, specifies a font family derived from the fontset. - It is only used if the face does not specify any family in ATTRS or - if we cannot find any font of the face's family. + PATTERN, if a string, specifies a font name pattern to match while + ignoring FAMILY and REGISTRY. - REGISTRY, if a string, specifies a font registry and encoding to - match. A value of nil means include fonts of any registry and - encoding. + FAMILY, if a list, specifies a list of font families to try. - If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY. - Otherwise, prefer FAMILY. + REGISTRY, if a list, specifies a list of font registries and + encodinging to try. Return in *FONTS a pointer to a vector of font_name structures for the fonts matched. Value is the number of fonts found. */ static int -try_font_list (f, attrs, family, registry, fonts, prefer_face_family) +try_font_list (f, pattern, family, registry, fonts) struct frame *f; - Lisp_Object *attrs; - Lisp_Object family, registry; + Lisp_Object pattern, family, registry; struct font_name **fonts; - int prefer_face_family; { int nfonts = 0; - Lisp_Object face_family = attrs[LFACE_FAMILY_INDEX]; - Lisp_Object try_family; - - try_family = (prefer_face_family || NILP (family)) ? face_family : family; - if (STRINGP (try_family)) - nfonts = try_alternative_families (f, try_family, registry, fonts); - -#ifdef MAC_OS - if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry)) - { - if (xstricmp (SDATA (registry), "mac-roman") == 0) - /* When realizing the default face and a font spec does not - matched exactly, Emacs looks for ones with the same registry - as the default font. On the Mac, this is mac-roman, which - does not work if the family is -etl-fixed, e.g. The - following widens the choices and fixes that problem. */ - nfonts = try_alternative_families (f, try_family, Qnil, fonts); - else if (SBYTES (try_family) > 0 - && SREF (try_family, SBYTES (try_family) - 1) != '*') - /* Some Central European/Cyrillic font family names have the - Roman counterpart name as their prefix. */ - nfonts = try_alternative_families (f, concat2 (try_family, - build_string ("*")), - registry, fonts); + if (STRINGP (pattern)) + { + nfonts = font_list (f, pattern, Qnil, Qnil, fonts); + if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt)) + { + int count = SPECPDL_INDEX (); + specbind (Qscalable_fonts_allowed, Qt); + nfonts = font_list (f, pattern, Qnil, Qnil, fonts); + unbind_to (count, Qnil); + } } -#endif + else + { + Lisp_Object tail; - if (EQ (try_family, family)) - family = face_family; + if (NILP (family)) + nfonts = font_list (f, Qnil, Qnil, registry, fonts); + else + for (tail = family; ! nfonts && CONSP (tail); tail = XCDR (tail)) + nfonts = try_alternative_families (f, XCAR (tail), registry, fonts); - if (nfonts == 0 && STRINGP (family)) - nfonts = try_alternative_families (f, family, registry, fonts); + /* Try font family of the default face or "fixed". */ + if (nfonts == 0 && !NILP (family)) + { + struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); + if (default_face) + family = default_face->lface[LFACE_FAMILY_INDEX]; + else + family = build_string ("fixed"); + nfonts = try_alternative_families (f, family, registry, fonts); + } - /* Try font family of the default face or "fixed". */ - if (nfonts == 0) - { - struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); - if (default_face) - family = default_face->lface[LFACE_FAMILY_INDEX]; - else - family = build_string ("fixed"); - nfonts = font_list (f, Qnil, family, registry, fonts); + /* Try any family with the given registry. */ + if (nfonts == 0 && !NILP (family)) + nfonts = try_alternative_families (f, Qnil, registry, fonts); } - /* Try any family with the given registry. */ - if (nfonts == 0) - nfonts = try_alternative_families (f, Qnil, registry, fonts); - return nfonts; } @@ -6862,63 +7258,109 @@ face_fontset (attrs) { Lisp_Object name; - name = attrs[LFACE_FONT_INDEX]; + name = attrs[LFACE_FONTSET_INDEX]; if (!STRINGP (name)) return -1; return fs_query_fontset (name, 0); } -/* Choose a name of font to use on frame F to display character C with +/* Choose a name of font to use on frame F to display characters with Lisp face attributes specified by ATTRS. The font name is - determined by the font-related attributes in ATTRS and the name - pattern for C in FONTSET. Value is the font name which is - allocated from the heap and must be freed by the caller, or NULL if - we can get no information about the font name of C. It is assured - that we always get some information for a single byte - character. + determined by the font-related attributes in ATTRS and FONT-SPEC + (if specified). - If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to - indicate whether the resulting font should be drawn using overstrike - to simulate bold-face. */ + When we are choosing a font for ASCII characters, FONT-SPEC is + always nil. Otherwise FONT-SPEC is an object created by + `font-spec' or a string specifying a font name pattern. -static char * -choose_face_font (f, attrs, fontset, c, needs_overstrike) + If NEEDS_OVERSTRIKE is not NULL, a boolean is returned in it to + indicate whether the resulting font should be drawn using + overstrike to simulate bold-face. + + Value is the font name which is allocated from the heap and must be + freed by the caller. */ + +char * +choose_face_font (f, attrs, font_spec, needs_overstrike) struct frame *f; Lisp_Object *attrs; - int fontset, c; + Lisp_Object font_spec; int *needs_overstrike; { - Lisp_Object pattern; + Lisp_Object pattern, family, adstyle, registry; char *font_name = NULL; struct font_name *fonts; - int nfonts, width_ratio; + int nfonts; if (needs_overstrike) *needs_overstrike = 0; - /* Get (foundry and) family name and registry (and encoding) name of - a font for C. */ - pattern = fontset_font_pattern (f, fontset, c); - if (NILP (pattern)) + /* If we are choosing an ASCII font and a font name is explicitly + specified in ATTRS, return it. */ + if (NILP (font_spec) && STRINGP (attrs[LFACE_FONT_INDEX])) + return xstrdup (SDATA (attrs[LFACE_FONT_INDEX])); + + if (NILP (attrs[LFACE_FAMILY_INDEX])) + family = Qnil; + else + family = Fcons (attrs[LFACE_FAMILY_INDEX], Qnil); + + /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But, + ADSTYLE is not used in the font selector for the moment. */ + if (VECTORP (font_spec)) { - xassert (!SINGLE_BYTE_CHAR_P (c)); - return NULL; + pattern = Qnil; + if (! NILP (AREF (font_spec, FONT_FAMILY_INDEX))) + family = Fcons (SYMBOL_NAME (AREF (font_spec, FONT_FAMILY_INDEX)), + family); + adstyle = AREF (font_spec, FONT_ADSTYLE_INDEX); + registry = Fcons (SYMBOL_NAME (AREF (font_spec, FONT_REGISTRY_INDEX)), + Qnil); + } + else if (STRINGP (font_spec)) + { + pattern = font_spec; + family = Qnil; + adstyle = Qnil; + registry = Qnil; + } + else + { + /* We are choosing an ASCII font. By default, use the registry + name "iso8859-1". But, if the registry name of the ASCII + font specified in the fontset of ATTRS is not "iso8859-1" + (e.g "iso10646-1"), use also that name with higher + priority. */ + int fontset = face_fontset (attrs); + Lisp_Object ascii; + int len; + struct font_name font; + + pattern = Qnil; + adstyle = Qnil; + registry = Fcons (build_string ("iso8859-1"), Qnil); + + ascii = fontset_ascii (fontset); + len = SBYTES (ascii); + if (len < 9 + || strcmp (SDATA (ascii) + len - 9, "iso8859-1")) + { + font.name = LSTRDUPA (ascii); + /* Check if the name is in XLFD. */ + if (split_font_name (f, &font, 0)) + { + font.fields[XLFD_ENCODING][-1] = '-'; + registry = Fcons (build_string (font.fields[XLFD_REGISTRY]), + registry); + } + } } - - /* If what we got is a name pattern, return it. */ - if (STRINGP (pattern)) - return xstrdup (SDATA (pattern)); /* Get a list of fonts matching that pattern and choose the best match for the specified face attributes from it. */ - nfonts = try_font_list (f, attrs, XCAR (pattern), XCDR (pattern), &fonts, - (SINGLE_BYTE_CHAR_P (c) - || CHAR_CHARSET (c) == charset_latin_iso8859_1)); - width_ratio = (SINGLE_BYTE_CHAR_P (c) - ? 1 - : CHARSET_WIDTH (CHAR_CHARSET (c))); - font_name = best_matching_font (f, attrs, fonts, nfonts, width_ratio, + nfonts = try_font_list (f, pattern, family, registry, &fonts); + font_name = best_matching_font (f, attrs, fonts, nfonts, NILP (font_spec), needs_overstrike); return font_name; } @@ -7007,12 +7449,27 @@ realize_default_face (f) #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) { +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + frame_font = font_find_object (FRAME_FONT_OBJECT (f)); + xassert (FONT_OBJECT_P (frame_font)); + set_lface_from_font_and_fontset (f, lface, frame_font, + FRAME_FONTSET (f), + f->default_face_done_p); + } + else + { +#endif /* USE_FONT_BACKEND */ /* Set frame_font to the value of the `font' frame parameter. */ frame_font = Fassq (Qfont, f->param_alist); xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font))); frame_font = XCDR (frame_font); set_lface_from_font_name (f, lface, frame_font, f->default_face_done_p, 1); +#ifdef USE_FONT_BACKEND + } +#endif /* USE_FONT_BACKEND */ f->default_face_done_p = 1; } #endif /* HAVE_WINDOW_SYSTEM */ @@ -7082,7 +7539,7 @@ realize_default_face (f) xassert (lface_fully_specified_p (XVECTOR (lface)->contents)); check_lface (lface); bcopy (XVECTOR (lface)->contents, attrs, sizeof attrs); - face = realize_face (c, attrs, 0, NULL, DEFAULT_FACE_ID); + face = realize_face (c, attrs, DEFAULT_FACE_ID); #ifdef HAVE_WINDOW_SYSTEM #ifdef HAVE_X_WINDOWS @@ -7139,23 +7596,19 @@ realize_named_face (f, symbol, id) merge_face_vectors (f, symbol_attrs, attrs, 0); /* Realize the face. */ - new_face = realize_face (c, attrs, 0, NULL, id); + new_face = realize_face (c, attrs, id); } /* Realize the fully-specified face with attributes ATTRS in face - cache CACHE for character C. If C is a multibyte character, - BASE_FACE is a face that has the same attributes. Otherwise, - BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an - ID of face to remove before caching the new face. Value is a - pointer to the newly created realized face. */ + cache CACHE for ASCII characters. If FORMER_FACE_ID is + non-negative, it is an ID of face to remove before caching the new + face. Value is a pointer to the newly created realized face. */ static struct face * -realize_face (cache, attrs, c, base_face, former_face_id) +realize_face (cache, attrs, former_face_id) struct face_cache *cache; Lisp_Object *attrs; - int c; - struct face *base_face; int former_face_id; { struct face *face; @@ -7173,9 +7626,9 @@ realize_face (cache, attrs, c, base_face, former_face_id) } if (FRAME_WINDOW_P (cache->f)) - face = realize_x_face (cache, attrs, c, base_face); + face = realize_x_face (cache, attrs); else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f)) - face = realize_tty_face (cache, attrs, c); + face = realize_tty_face (cache, attrs); else if (FRAME_INITIAL_P (cache->f)) { /* Create a dummy face. */ @@ -7186,29 +7639,70 @@ realize_face (cache, attrs, c, base_face, former_face_id) /* Insert the new face. */ cache_face (cache, face, lface_hash (attrs)); + return face; +} + + #ifdef HAVE_WINDOW_SYSTEM - if (FRAME_WINDOW_P (cache->f) && face->font == NULL) - load_face_font (cache->f, face, c); -#endif /* HAVE_WINDOW_SYSTEM */ +/* Realize the fully-specified face that has the same attributes as + BASE_FACE except for the font on frame F. If FONT_ID is not + negative, it is an ID number of an already opened font that should + be used by the face. If FONT_ID is negative, the face has no font, + i.e., characters are displayed by empty boxes. */ + +static struct face * +realize_non_ascii_face (f, font_id, base_face) + struct frame *f; + int font_id; + struct face *base_face; +{ + struct face_cache *cache = FRAME_FACE_CACHE (f); + struct face *face; + struct font_info *font_info; + + face = (struct face *) xmalloc (sizeof *face); + *face = *base_face; + face->gc = 0; +#ifdef USE_FONT_BACKEND + face->extra = NULL; +#endif + + /* Don't try to free the colors copied bitwise from BASE_FACE. */ + face->colors_copied_bitwise_p = 1; + + face->font_info_id = font_id; + if (font_id >= 0) + { + font_info = FONT_INFO_FROM_ID (f, font_id); + face->font = font_info->font; + face->font_name = font_info->full_name; + } + else + { + face->font = NULL; + face->font_name = NULL; + } + + face->gc = 0; + + cache_face (cache, face, face->hash); + return face; } +#endif /* HAVE_WINDOW_SYSTEM */ /* Realize the fully-specified face with attributes ATTRS in face - cache CACHE for character C. Do it for X frame CACHE->f. If C is - a multibyte character, BASE_FACE is a face that has the same - attributes. Otherwise, BASE_FACE is ignored. If the new face - doesn't share font with the default face, a fontname is allocated - from the heap and set in `font_name' of the new face, but it is not - yet loaded here. Value is a pointer to the newly created realized - face. */ + cache CACHE for ASCII characters. Do it for X frame CACHE->f. If + the new face doesn't share font with the default face, a fontname + is allocated from the heap and set in `font_name' of the new face, + but it is not yet loaded here. Value is a pointer to the newly + created realized face. */ static struct face * -realize_x_face (cache, attrs, c, base_face) +realize_x_face (cache, attrs) struct face_cache *cache; Lisp_Object *attrs; - int c; - struct face *base_face; { struct face *face = NULL; #ifdef HAVE_WINDOW_SYSTEM @@ -7217,50 +7711,27 @@ realize_x_face (cache, attrs, c, base_face) Lisp_Object stipple, overline, strike_through, box; xassert (FRAME_WINDOW_P (cache->f)); - xassert (SINGLE_BYTE_CHAR_P (c) - || base_face); /* Allocate a new realized face. */ face = make_realized_face (attrs); + face->ascii_face = face; f = cache->f; - /* If C is a multibyte character, we share all face attirbutes with - BASE_FACE including the realized fontset. But, we must load a - different font. */ - if (!SINGLE_BYTE_CHAR_P (c)) - { - bcopy (base_face, face, sizeof *face); - face->gc = 0; - - /* Don't try to free the colors copied bitwise from BASE_FACE. */ - face->colors_copied_bitwise_p = 1; - - /* to force realize_face to load font */ - face->font = NULL; - return face; - } - - /* Now we are realizing a face for ASCII (and unibyte) characters. */ - /* Determine the font to use. Most of the time, the font will be the same as the font of the default face, so try that first. */ default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); if (default_face - && FACE_SUITABLE_FOR_CHAR_P (default_face, c) && lface_same_font_attributes_p (default_face->lface, attrs)) { face->font = default_face->font; - face->fontset = default_face->fontset; face->font_info_id = default_face->font_info_id; +#ifdef USE_FONT_BACKEND + face->font_info = default_face->font_info; +#endif /* USE_FONT_BACKEND */ face->font_name = default_face->font_name; - face->ascii_face = face; - - /* But, as we can't share the fontset, make a new realized - fontset that has the same base fontset as of the default - face. */ face->fontset - = make_fontset_for_ascii_face (f, default_face->fontset); + = make_fontset_for_ascii_face (f, default_face->fontset, face); } else { @@ -7272,10 +7743,24 @@ realize_x_face (cache, attrs, c, base_face) are constructed from ATTRS. */ int fontset = face_fontset (attrs); - if ((fontset == -1) && default_face) + /* If we are realizing the default face, ATTRS should specify a + fontset. In other words, if FONTSET is -1, we are not + realizing the default face, thus the default face should have + already been realized. */ + if (fontset == -1) fontset = default_face->fontset; - face->fontset = make_fontset_for_ascii_face (f, fontset); - face->font = NULL; /* to force realize_face to load font */ + if (fontset == -1) + abort (); +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + font_load_for_face (f, face); + else +#endif /* USE_FONT_BACKEND */ + load_face_font (f, face); + if (face->font) + face->fontset = make_fontset_for_ascii_face (f, fontset, face); + else + face->fontset = -1; } /* Load colors, and set remaining attributes. */ @@ -7406,9 +7891,8 @@ realize_x_face (cache, attrs, c, base_face) stipple = attrs[LFACE_STIPPLE_INDEX]; if (!NILP (stipple)) face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h); - - xassert (FACE_SUITABLE_FOR_CHAR_P (face, c)); #endif /* HAVE_WINDOW_SYSTEM */ + return face; } @@ -7496,14 +7980,13 @@ map_tty_color (f, face, idx, defaulted) /* Realize the fully-specified face with attributes ATTRS in face - cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a - pointer to the newly created realized face. */ + cache CACHE for ASCII characters. Do it for TTY frame CACHE->f. + Value is a pointer to the newly created realized face. */ static struct face * -realize_tty_face (cache, attrs, c) +realize_tty_face (cache, attrs) struct face_cache *cache; Lisp_Object *attrs; - int c; { struct face *face; int weight, slant; @@ -7596,7 +8079,7 @@ compute_char_face (f, ch, prop) if (NILP (prop)) { struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID); - face_id = FACE_FOR_CHAR (f, face, ch); + face_id = FACE_FOR_CHAR (f, face, ch, -1, Qnil); } else { @@ -7604,7 +8087,7 @@ compute_char_face (f, ch, prop) struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID); bcopy (default_face->lface, attrs, sizeof attrs); merge_face_ref (f, prop, attrs, 1, 0); - face_id = lookup_face (f, attrs, ch, NULL); + face_id = lookup_face (f, attrs); } return face_id; @@ -7721,7 +8204,7 @@ face_at_buffer_position (w, pos, region_beg, region_end, /* Look up a realized face with the given face attributes, or realize a new one for ASCII characters. */ - return lookup_face (f, attrs, 0, NULL); + return lookup_face (f, attrs); } /* Return the face ID at buffer position POS for displaying ASCII @@ -7800,7 +8283,7 @@ face_for_overlay_string (w, pos, region_beg, region_end, /* Look up a realized face with the given face attributes, or realize a new one for ASCII characters. */ - return lookup_face (f, attrs, 0, NULL); + return lookup_face (f, attrs); } @@ -7896,7 +8379,7 @@ face_at_string_position (w, string, pos, bufpos, region_beg, /* Look up a realized face with the given face attributes, or realize a new one for ASCII characters. */ - return lookup_face (f, attrs, 0, NULL); + return lookup_face (f, attrs); } @@ -7933,7 +8416,7 @@ merge_faces (f, face_name, face_id, base_face_id) if (face_id < 0 || face_id >= lface_id_to_name_size) return base_face_id; face_name = lface_id_to_name[face_id]; - face_id = lookup_derived_face (f, face_name, 0, base_face_id, 1); + face_id = lookup_derived_face (f, face_name, base_face_id, 1); if (face_id >= 0) return face_id; return base_face_id; @@ -7960,7 +8443,7 @@ merge_faces (f, face_name, face_id, base_face_id) /* Look up a realized face with the given face attributes, or realize a new one for ASCII characters. */ - return lookup_face (f, attrs, 0, NULL); + return lookup_face (f, attrs); } @@ -7998,7 +8481,6 @@ dump_realized_face (face) face->underline_p, SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX]))); fprintf (stderr, "hash: %d\n", face->hash); - fprintf (stderr, "charset: %d\n", face->charset); } @@ -8091,6 +8573,8 @@ syms_of_xfaces () staticpro (&QCwidth); QCfont = intern (":font"); staticpro (&QCfont); + QCfontset = intern (":fontset"); + staticpro (&QCfontset); QCbold = intern (":bold"); staticpro (&QCbold); QCitalic = intern (":italic"); diff --git a/src/xfns.c b/src/xfns.c index 96631d98f55..8239fc3475c 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -41,6 +41,7 @@ Boston, MA 02110-1301, USA. */ #include "keyboard.h" #include "blockinput.h" #include <epaths.h> +#include "character.h" #include "charset.h" #include "coding.h" #include "fontset.h" @@ -49,6 +50,10 @@ Boston, MA 02110-1301, USA. */ #include "atimer.h" #include "termchar.h" +#ifdef USE_FONT_BACKEND +#include "font.h" +#endif /* USE_FONT_BACKEND */ + #ifdef HAVE_X_WINDOWS #include <ctype.h> @@ -310,10 +315,10 @@ x_window_to_frame (dpyinfo, wdesc) if (wdesc == None) return 0; - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { frame = XCAR (tail); - if (!GC_FRAMEP (frame)) + if (!FRAMEP (frame)) continue; f = XFRAME (frame); if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo) @@ -362,10 +367,10 @@ x_any_window_to_frame (dpyinfo, wdesc) if (wdesc == None) return NULL; found = NULL; - for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail) && !found; tail = XCDR (tail)) { frame = XCAR (tail); - if (!GC_FRAMEP (frame)) + if (!FRAMEP (frame)) continue; f = XFRAME (frame); @@ -417,10 +422,10 @@ x_non_menubar_window_to_frame (dpyinfo, wdesc) if (wdesc == None) return 0; - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { frame = XCAR (tail); - if (!GC_FRAMEP (frame)) + if (!FRAMEP (frame)) continue; f = XFRAME (frame); if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo) @@ -465,10 +470,10 @@ x_menubar_window_to_frame (dpyinfo, wdesc) if (wdesc == None) return 0; - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { frame = XCAR (tail); - if (!GC_FRAMEP (frame)) + if (!FRAMEP (frame)) continue; f = XFRAME (frame); if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo) @@ -512,10 +517,10 @@ x_top_window_to_frame (dpyinfo, wdesc) if (wdesc == None) return 0; - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { frame = XCAR (tail); - if (!GC_FRAMEP (frame)) + if (!FRAMEP (frame)) continue; f = XFRAME (frame); if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo) @@ -552,6 +557,8 @@ x_top_window_to_frame (dpyinfo, wdesc) +static void x_default_font_parameter P_ ((struct frame *, Lisp_Object)); + static Lisp_Object unwind_create_frame P_ ((Lisp_Object)); static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object)); @@ -1551,55 +1558,30 @@ x_encode_text (string, coding_system, selectionp, text_bytes, stringp, freep) int selectionp; int *freep; { - unsigned char *str = SDATA (string); - int chars = SCHARS (string); - int bytes = SBYTES (string); - int charset_info; - int bufsize; - unsigned char *buf; + int result = string_xstring_p (string); struct coding_system coding; - extern Lisp_Object Qcompound_text_with_extensions; - charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil); - if (charset_info == 0) + if (result == 0) { /* No multibyte character in OBJ. We need not encode it. */ - *text_bytes = bytes; + *text_bytes = SBYTES (string); *stringp = 1; *freep = 0; - return str; + return SDATA (string); } setup_coding_system (coding_system, &coding); - if (selectionp - && SYMBOLP (coding.pre_write_conversion) - && !NILP (Ffboundp (coding.pre_write_conversion))) - { - struct gcpro gcpro1; - /* We don't need to GCPRO string. */ - GCPRO1 (coding_system); - string = run_pre_post_conversion_on_str (string, &coding, 1); - UNGCPRO; - str = SDATA (string); - chars = SCHARS (string); - bytes = SBYTES (string); - } - coding.src_multibyte = 1; - coding.dst_multibyte = 0; - coding.mode |= CODING_MODE_LAST_BLOCK; - if (coding.type == coding_type_iso2022) - coding.flags |= CODING_FLAG_ISO_SAFE; + coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK); /* We suppress producing escape sequences for composition. */ - coding.composing = COMPOSITION_DISABLED; - bufsize = encoding_buffer_size (&coding, bytes); - buf = (unsigned char *) xmalloc (bufsize); - encode_coding (&coding, str, buf, bytes, bufsize); + coding.common_flags &= ~CODING_ANNOTATION_MASK; + coding.dst_bytes = SCHARS (string) * 2; + coding.destination = (unsigned char *) xmalloc (coding.dst_bytes); + encode_coding_object (&coding, string, 0, 0, + SCHARS (string), SBYTES (string), Qnil); *text_bytes = coding.produced; - *stringp = (charset_info == 1 - || (!EQ (coding_system, Qcompound_text) - && !EQ (coding_system, Qcompound_text_with_extensions))); + *stringp = (result == 1 || !EQ (coding_system, Qcompound_text)); *freep = 1; - return buf; + return coding.destination; } @@ -1946,6 +1928,7 @@ hack_wm_protocols (f, widget) #ifdef HAVE_X_I18N static XFontSet xic_create_xfontset P_ ((struct frame *, char *)); +static XFontSet xic_create_xfontset2 P_ ((struct frame *)); static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *)); @@ -2097,6 +2080,29 @@ xic_create_fontsetname (base_fontname, motif) return fontsetname; } +#ifdef DEBUG_XIC_FONTSET +static void +print_fontset_result (xfs, name, missing_list, missing_count) + XFontSet xfs; + char *name; + char **missing_list; + int missing_count; +{ + if (xfs) + fprintf (stderr, "XIC Fontset created: %s\n", name); + else + { + fprintf (stderr, "XIC Fontset failed: %s\n", name); + while (missing_count-- > 0) + { + fprintf (stderr, " missing: %s\n", *missing_list); + missing_list++; + } + } + +} +#endif + static XFontSet xic_create_xfontset (f, base_fontname) struct frame *f; @@ -2133,6 +2139,9 @@ xic_create_xfontset (f, base_fontname) xfs = XCreateFontSet (FRAME_X_DISPLAY (f), fontsetname, &missing_list, &missing_count, &def_string); +#ifdef DEBUG_XIC_FONTSET + print_fontset_result (xfs, fontsetname, missing_list, missing_count); +#endif if (missing_list) XFreeStringList (missing_list); if (! xfs) @@ -2151,6 +2160,9 @@ xic_create_xfontset (f, base_fontname) xfs = XCreateFontSet (FRAME_X_DISPLAY (f), p0, &missing_list, &missing_count, &def_string); +#ifdef DEBUG_XIC_FONTSET + print_fontset_result (xfs, p0, missing_list, missing_count); +#endif if (missing_list) XFreeStringList (missing_list); if (xfs) @@ -2159,6 +2171,20 @@ xic_create_xfontset (f, base_fontname) } } xfree (fontsetname); + if (! xfs && base_fontname != xic_defaut_fontset) + { + /* Try the default fontset name at a last resort. */ + fontsetname = xic_create_fontsetname (xic_defaut_fontset, False); + xfs = XCreateFontSet (FRAME_X_DISPLAY (f), + fontsetname, &missing_list, + &missing_count, &def_string); +#ifdef DEBUG_XIC_FONTSET + print_fontset_result (xfs, fontsetname, missing_list, missing_count); +#endif + if (missing_list) + XFreeStringList (missing_list); + xfree (fontsetname); + } } if (FRAME_XIC_BASE_FONTNAME (f)) @@ -2169,6 +2195,107 @@ xic_create_xfontset (f, base_fontname) return xfs; } +#ifdef USE_FONT_BACKEND + +static XFontSet +xic_create_xfontset2 (f) + struct frame *f; +{ + XFontSet xfs = NULL; + struct font *font = FRAME_FONT_OBJECT (f); + int pixel_size = font->pixel_size; + Lisp_Object rest, frame; + + /* See if there is another frame already using same fontset. */ + FOR_EACH_FRAME (rest, frame) + { + struct frame *cf = XFRAME (frame); + + if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf) + && FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f) + && FRAME_FONT_OBJECT (f) + && FRAME_FONT_OBJECT (f)->pixel_size == pixel_size) + { + xfs = FRAME_XIC_FONTSET (cf); + break; + } + } + + if (! xfs) + { + char buf[256]; + char **missing_list; + int missing_count; + char *def_string; + char *xlfd_format = "-*-*-medium-r-normal--%d-*-*-*-*-*"; + + sprintf (buf, xlfd_format, pixel_size); + missing_list = NULL; + xfs = XCreateFontSet (FRAME_X_DISPLAY (f), buf, + &missing_list, &missing_count, &def_string); +#ifdef DEBUG_XIC_FONTSET + print_fontset_result (xfs, buf, missing_list, missing_count); +#endif + if (missing_list) + XFreeStringList (missing_list); + if (! xfs) + { + /* List of pixel sizes most likely available. Find one that + is closest to pixel_size. */ + int sizes[] = {0, 8, 10, 11, 12, 14, 17, 18, 20, 24, 26, 34, 0}; + int *smaller, *larger; + + for (smaller = sizes; smaller[1]; smaller++) + if (smaller[1] >= pixel_size) + break; + larger = smaller + 1; + if (*larger == pixel_size) + larger++; + while (*smaller || *larger) + { + int this_size; + + if (! *larger) + this_size = *smaller--; + else if (! *smaller) + this_size = *larger++; + else if (pixel_size - *smaller < *larger - pixel_size) + this_size = *smaller--; + else + this_size = *larger++; + sprintf (buf, xlfd_format, this_size); + missing_list = NULL; + xfs = XCreateFontSet (FRAME_X_DISPLAY (f), buf, + &missing_list, &missing_count, &def_string); +#ifdef DEBUG_XIC_FONTSET + print_fontset_result (xfs, buf, missing_list, missing_count); +#endif + if (missing_list) + XFreeStringList (missing_list); + if (xfs) + break; + } + } + if (! xfs) + { + char *last_resort = "-*-*-*-r-normal--*-*-*-*-*-*"; + + missing_list = NULL; + xfs = XCreateFontSet (FRAME_X_DISPLAY (f), last_resort, + &missing_list, &missing_count, &def_string); +#ifdef DEBUG_XIC_FONTSET + print_fontset_result (xfs, last_resort, missing_list, missing_count); +#endif + if (missing_list) + XFreeStringList (missing_list); + } + + } + + return xfs; +} +#endif /* USE_FONT_BACKEND */ + /* Free the X fontset of frame F if it is the last frame using it. */ void @@ -2241,6 +2368,11 @@ create_frame_xic (f) return; /* Create X fontset. */ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + xfs = xic_create_xfontset2 (f); + else +#endif xfs = xic_create_xfontset (f, (FRAME_FONTSET (f) < 0) ? NULL : (char *) SDATA (fontset_ascii (FRAME_FONTSET (f)))); @@ -2399,6 +2531,11 @@ xic_set_xfontset (f, base_fontname) xic_free_xfontset (f); +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + xfs = xic_create_xfontset2 (f); + else +#endif xfs = xic_create_xfontset (f, base_fontname); attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL); @@ -3026,6 +3163,44 @@ unwind_create_frame (frame) return Qnil; } +#ifdef USE_FONT_BACKEND +static void +x_default_font_parameter (f, parms) + struct frame *f; + Lisp_Object parms; +{ + struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Lisp_Object font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", + RES_TYPE_STRING); + + if (! STRINGP (font)) + { + char *names[] + = { "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1", + "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1", + "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1", + /* This was formerly the first thing tried, but it finds + too many fonts and takes too long. */ + "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1", + /* If those didn't work, look for something which will + at least work. */ + "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1", + "fixed", + NULL }; + int i; + + for (i = 0; names[i]; i++) + { + font = font_open_by_name (f, names[i]); + if (! NILP (font)) + break; + } + if (NILP (font)) + error ("No suitable font was found"); + } + x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING); +} +#endif /* USE_FONT_BACKEND */ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, @@ -3206,43 +3381,75 @@ This function is an internal primitive--use `make-frame' instead. */) specbind (Qx_resource_name, name); } + f->resx = dpyinfo->resx; + f->resy = dpyinfo->resy; + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + /* Perhaps, we must allow frame parameter, say `font-backend', + to specify which font backends to use. */ +#ifdef HAVE_FREETYPE +#ifdef HAVE_XFT + register_font_driver (&xftfont_driver, f); +#else /* not HAVE_XFT */ + register_font_driver (&ftxfont_driver, f); +#endif /* not HAVE_XFT */ +#endif /* HAVE_FREETYPE */ + register_font_driver (&xfont_driver, f); + + x_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + } +#endif /* USE_FONT_BACKEND */ + /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + x_default_font_parameter (f, parms); +else +#endif /* USE_FONT_BACKEND */ { Lisp_Object font; font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING); - BLOCK_INPUT; - /* First, try whatever font the caller has specified. */ - if (STRINGP (font)) - { - tem = Fquery_fontset (font, Qnil); - if (STRINGP (tem)) - font = x_new_fontset (f, SDATA (tem)); - else - font = x_new_font (f, SDATA (font)); - } - - /* Try out a font which we hope has bold and italic variations. */ - if (!STRINGP (font)) - font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"); + /* If the caller has specified no font, try out fonts which we + hope have bold and italic variations. */ if (!STRINGP (font)) - font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1"); - if (! STRINGP (font)) - font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1"); - if (! STRINGP (font)) - /* This was formerly the first thing tried, but it finds too many fonts - and takes too long. */ - font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1"); - /* If those didn't work, look for something which will at least work. */ - if (! STRINGP (font)) - font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1"); - UNBLOCK_INPUT; - if (! STRINGP (font)) - font = build_string ("fixed"); + { + char *names[] + = { "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1", + "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1", + "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1", + /* This was formerly the first thing tried, but it finds + too many fonts and takes too long. */ + "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1", + /* If those didn't work, look for something which will + at least work. */ + "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1", + NULL }; + int i; + + BLOCK_INPUT; + for (i = 0; names[i]; i++) + { + Lisp_Object list; - x_set_frame_parameters (f, Fcons (Fcons (Qfont, font), Qnil)); + list = x_list_fonts (f, build_string (names[i]), 0, 1); + if (CONSP (list)) + { + font = XCAR (list); + break; + } + } + UNBLOCK_INPUT; + if (! STRINGP (font)) + font = build_string ("fixed"); + } + x_default_parameter (f, parms, Qfont, font, + "font", "Font", RES_TYPE_STRING); } #ifdef USE_LUCID @@ -4767,8 +4974,35 @@ x_create_tip_frame (dpyinfo, parms, text) specbind (Qx_resource_name, name); } + f->resx = dpyinfo->resx; + f->resy = dpyinfo->resy; + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + /* Perhaps, we must allow frame parameter, say `font-backend', + to specify which font backends to use. */ +#ifdef HAVE_FREETYPE +#ifdef HAVE_XFT + register_font_driver (&xftfont_driver, f); +#else /* not HAVE_XFT */ + register_font_driver (&ftxfont_driver, f); +#endif /* not HAVE_XFT */ +#endif /* HAVE_FREETYPE */ + register_font_driver (&xfont_driver, f); + + x_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + } +#endif /* USE_FONT_BACKEND */ + /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + x_default_font_parameter (f, parms); +else +#endif /* USE_FONT_BACKEND */ { Lisp_Object font; @@ -4780,7 +5014,7 @@ x_create_tip_frame (dpyinfo, parms, text) { tem = Fquery_fontset (font, Qnil); if (STRINGP (tem)) - font = x_new_fontset (f, SDATA (tem)); + font = x_new_fontset (f, tem); else font = x_new_font (f, SDATA (font)); } @@ -4803,8 +5037,7 @@ x_create_tip_frame (dpyinfo, parms, text) if (! STRINGP (font)) font = build_string ("fixed"); - x_default_parameter (f, parms, Qfont, font, - "font", "Font", RES_TYPE_STRING); + x_set_frame_parameters (f, Fcons (Fcons (Qfont, font), Qnil)); } x_default_parameter (f, parms, Qborder_width, make_number (2), @@ -5745,6 +5978,9 @@ frame_parm_handler x_frame_parm_handlers[] = x_set_fringe_width, x_set_wait_for_wm, x_set_fullscreen, +#ifdef USE_FONT_BACKEND + x_set_font_backend +#endif /* USE_FONT_BACKEND */ }; void @@ -5955,6 +6191,7 @@ the tool bar buttons. */); find_ccl_program_func = x_find_ccl_program; query_font_func = x_query_font; set_frame_fontset_func = x_set_font; + get_font_repertory_func = x_get_font_repertory; check_window_system_func = check_x; hourglass_atimer = NULL; diff --git a/src/xfont.c b/src/xfont.c new file mode 100644 index 00000000000..b759ee05294 --- /dev/null +++ b/src/xfont.c @@ -0,0 +1,827 @@ +/* xfont.c -- X core font driver. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> +#include <X11/Xlib.h> + +#include "lisp.h" +#include "dispextern.h" +#include "xterm.h" +#include "frame.h" +#include "blockinput.h" +#include "character.h" +#include "charset.h" +#include "fontset.h" +#include "font.h" + + +/* X core font driver. */ + +/* Prototypes of support functions. */ +extern void x_clear_errors P_ ((Display *)); + +static char *xfont_query_font P_ ((Display *, char *, Lisp_Object)); +static XCharStruct *xfont_get_pcm P_ ((XFontStruct *, XChar2b *)); +static int xfont_registry_charsets P_ ((Lisp_Object, struct charset **, + struct charset **)); + +static char * +xfont_query_font (display, name, spec) + Display *display; + char *name; + Lisp_Object spec; +{ + XFontStruct *font; + + BLOCK_INPUT; + x_catch_errors (display); + font = XLoadQueryFont (display, name); + name = NULL; + if (x_had_errors_p (display)) + { + /* This error is perhaps due to insufficient memory on X + server. Let's just ignore it. */ + x_clear_errors (display); + } + else if (font) + { + unsigned long value; + + if (XGetFontProperty (font, XA_FONT, &value)) + { + char *n = (char *) XGetAtomName (display, (Atom) value); + + if (font_parse_xlfd (n, spec) >= 0) + name = n; + else + XFree (n); + } + XFreeFont (display, font); + } + x_uncatch_errors (); + UNBLOCK_INPUT; + + return name; +} + + +/* Get metrics of character CHAR2B in XFONT. Value is null if CHAR2B + is not contained in the font. */ + +static XCharStruct * +xfont_get_pcm (xfont, char2b) + XFontStruct *xfont; + XChar2b *char2b; +{ + /* The result metric information. */ + XCharStruct *pcm = NULL; + + xassert (xfont && char2b); + + if (xfont->per_char != NULL) + { + if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0) + { + /* min_char_or_byte2 specifies the linear character index + corresponding to the first element of the per_char array, + max_char_or_byte2 is the index of the last character. A + character with non-zero CHAR2B->byte1 is not in the font. + A character with byte2 less than min_char_or_byte2 or + greater max_char_or_byte2 is not in the font. */ + if (char2b->byte1 == 0 + && char2b->byte2 >= xfont->min_char_or_byte2 + && char2b->byte2 <= xfont->max_char_or_byte2) + pcm = xfont->per_char + char2b->byte2 - xfont->min_char_or_byte2; + } + else + { + /* If either min_byte1 or max_byte1 are nonzero, both + min_char_or_byte2 and max_char_or_byte2 are less than + 256, and the 2-byte character index values corresponding + to the per_char array element N (counting from 0) are: + + byte1 = N/D + min_byte1 + byte2 = N\D + min_char_or_byte2 + + where: + + D = max_char_or_byte2 - min_char_or_byte2 + 1 + / = integer division + \ = integer modulus */ + if (char2b->byte1 >= xfont->min_byte1 + && char2b->byte1 <= xfont->max_byte1 + && char2b->byte2 >= xfont->min_char_or_byte2 + && char2b->byte2 <= xfont->max_char_or_byte2) + pcm = (xfont->per_char + + ((xfont->max_char_or_byte2 - xfont->min_char_or_byte2 + 1) + * (char2b->byte1 - xfont->min_byte1)) + + (char2b->byte2 - xfont->min_char_or_byte2)); + } + } + else + { + /* If the per_char pointer is null, all glyphs between the first + and last character indexes inclusive have the same + information, as given by both min_bounds and max_bounds. */ + if (char2b->byte2 >= xfont->min_char_or_byte2 + && char2b->byte2 <= xfont->max_char_or_byte2) + pcm = &xfont->max_bounds; + } + + return ((pcm == NULL + || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0)) + ? NULL : pcm); +} + +static Lisp_Object xfont_get_cache P_ ((FRAME_PTR)); +static Lisp_Object xfont_list P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object xfont_match P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object xfont_list_family P_ ((Lisp_Object)); +static struct font *xfont_open P_ ((FRAME_PTR, Lisp_Object, int)); +static void xfont_close P_ ((FRAME_PTR, struct font *)); +static int xfont_prepare_face P_ ((FRAME_PTR, struct face *)); +#if 0 +static void xfont_done_face P_ ((FRAME_PTR, struct face *)); +#endif +static int xfont_has_char P_ ((Lisp_Object, int)); +static unsigned xfont_encode_char P_ ((struct font *, int)); +static int xfont_text_extents P_ ((struct font *, unsigned *, int, + struct font_metrics *)); +static int xfont_draw P_ ((struct glyph_string *, int, int, int, int, int)); + +struct font_driver xfont_driver = + { + 0, /* Qx */ + xfont_get_cache, + xfont_list, + xfont_match, + xfont_list_family, + NULL, + xfont_open, + xfont_close, + xfont_prepare_face, + NULL /*xfont_done_face*/, + xfont_has_char, + xfont_encode_char, + xfont_text_extents, + xfont_draw + }; + +extern Lisp_Object QCname; + +static Lisp_Object +xfont_get_cache (f) + FRAME_PTR f; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + + return (dpyinfo->name_list_element); +} + +extern Lisp_Object Vface_alternative_font_registry_alist; + +static Lisp_Object +xfont_list_pattern (frame, display, pattern) + Lisp_Object frame; + Display *display; + char *pattern; +{ + Lisp_Object list = Qnil; + int i, limit, num_fonts; + char **names; + + BLOCK_INPUT; + x_catch_errors (display); + + for (limit = 512; ; limit *= 2) + { + names = XListFonts (display, pattern, limit, &num_fonts); + if (x_had_errors_p (display)) + { + /* This error is perhaps due to insufficient memory on X + server. Let's just ignore it. */ + x_clear_errors (display); + num_fonts = 0; + break; + } + if (num_fonts < limit) + break; + XFreeFontNames (names); + } + + for (i = 0; i < num_fonts; i++) + { + Lisp_Object entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil); + int result; + + ASET (entity, FONT_TYPE_INDEX, Qx); + ASET (entity, FONT_FRAME_INDEX, frame); + + result = font_parse_xlfd (names[i], entity); + if (result < 0) + { + /* This may be an alias name. Try to get the full XLFD name + from XA_FONT property of the font. */ + XFontStruct *font = XLoadQueryFont (display, names[i]); + unsigned long value; + + if (! font) + continue; + if (XGetFontProperty (font, XA_FONT, &value)) + { + char *name = (char *) XGetAtomName (display, (Atom) value); + int len = strlen (name); + + /* If DXPC (a Differential X Protocol Compressor) + Ver.3.7 is running, XGetAtomName will return null + string. We must avoid such a name. */ + if (len > 0) + result = font_parse_xlfd (name, entity); + XFree (name); + } + XFreeFont (display, font); + } + + if (result == 0) + { + Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX); + char *p = (char *) SDATA (SYMBOL_NAME (val)); + + /* P == "RESX-RESY-SPACING-AVGWIDTH. We rejust this font if + it's an autoscaled one (i.e. RESX > 0 && AVGWIDTH == 0). */ + if (atoi (p) > 0) + { + p += SBYTES (SYMBOL_NAME (val)); + while (p[-1] != '-') p--; + if (atoi (p) == 0) + continue; + } + list = Fcons (entity, list); + } + } + + x_uncatch_errors (); + UNBLOCK_INPUT; + + return list; +} + +static Lisp_Object +xfont_list (frame, spec) + Lisp_Object frame, spec; +{ + FRAME_PTR f = XFRAME (frame); + Display *display = FRAME_X_DISPLAY_INFO (f)->display; + Lisp_Object list, val, extra, font_name; + int len; + char name[256]; + + extra = AREF (spec, FONT_EXTRA_INDEX); + font_name = Qnil; + if (CONSP (extra)) + { + val = assq_no_quit (QCotf, extra); + if (! NILP (val)) + return null_vector; + val = assq_no_quit (QCscript, extra); + if (! NILP (val)) + return null_vector; + val = assq_no_quit (QClanguage, extra); + if (! NILP (val)) + return null_vector; + val = assq_no_quit (QCname, extra); + if (CONSP (val)) + font_name = XCDR (val); + } + + if (STRINGP (font_name) + && ! strchr ((char *) SDATA (font_name), ':')) + list = xfont_list_pattern (frame, display, (char *) SDATA (font_name)); + else if ((len = font_unparse_xlfd (spec, 0, name, 256)) < 0) + return null_vector; + else + { + list = xfont_list_pattern (frame, display, name); + if (NILP (list)) + { + Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX); + Lisp_Object alter; + + if (! NILP (registry) + && (alter = Fassoc (SYMBOL_NAME (registry), + Vface_alternative_font_registry_alist), + CONSP (alter))) + { + /* Pointer to REGISTRY-ENCODING field. */ + char *r = name + len - SBYTES (SYMBOL_NAME (registry)); + + for (alter = XCDR (alter); CONSP (alter); alter = XCDR (alter)) + if (STRINGP (XCAR (alter)) + && ((r - name) + SBYTES (XCAR (alter))) < 255) + { + strcpy (r, (char *) SDATA (XCAR (alter))); + list = xfont_list_pattern (frame, display, name); + if (! NILP (list)) + break; + } + } + } + } + + return (NILP (list) ? null_vector : Fvconcat (1, &list)); +} + +static Lisp_Object +xfont_match (frame, spec) + Lisp_Object frame, spec; +{ + FRAME_PTR f = XFRAME (frame); + Display *display = FRAME_X_DISPLAY_INFO (f)->display; + Lisp_Object extra, val, entity; + char *name; + XFontStruct *xfont; + unsigned long value; + + extra = AREF (spec, FONT_EXTRA_INDEX); + val = assq_no_quit (QCname, extra); + if (! CONSP (val) || ! STRINGP (XCDR (val))) + return Qnil; + + BLOCK_INPUT; + entity = Qnil; + name = (char *) SDATA (XCDR (val)); + xfont = XLoadQueryFont (display, name); + if (xfont) + { + if (XGetFontProperty (xfont, XA_FONT, &value)) + { + int len; + + name = (char *) XGetAtomName (display, (Atom) value); + len = strlen (name); + + /* If DXPC (a Differential X Protocol Compressor) + Ver.3.7 is running, XGetAtomName will return null + string. We must avoid such a name. */ + if (len > 0) + { + entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil); + ASET (entity, FONT_TYPE_INDEX, Qx); + ASET (entity, FONT_FRAME_INDEX, frame); + if (font_parse_xlfd (name, entity) < 0) + entity = Qnil; + } + XFree (name); + } + XFreeFont (display, xfont); + } + UNBLOCK_INPUT; + + return entity; +} + +static int +memq_no_quit (elt, list) + Lisp_Object elt, list; +{ + while (CONSP (list) && ! EQ (XCAR (list), elt)) + list = XCDR (list); + return (CONSP (list)); +} + +static Lisp_Object +xfont_list_family (frame) + Lisp_Object frame; +{ + FRAME_PTR f = XFRAME (frame); + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + char **names; + int num_fonts, i; + Lisp_Object list; + char *last_family; + int last_len; + + BLOCK_INPUT; + x_catch_errors (dpyinfo->display); + names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*", + 0x8000, &num_fonts); + if (x_had_errors_p (dpyinfo->display)) + { + /* This error is perhaps due to insufficient memory on X server. + Let's just ignore it. */ + x_clear_errors (dpyinfo->display); + num_fonts = 0; + } + + list = Qnil; + for (i = 0, last_len = 0; i < num_fonts; i++) + { + char *p0 = names[i], *p1; + Lisp_Object family; + + p0++; /* skip the leading '-' */ + while (*p0 && *p0 != '-') p0++; /* skip foundry */ + if (! *p0) + continue; + p1 = ++p0; + while (*p1 && *p1 != '-') p1++; /* find the end of family */ + if (! *p1 || p1 == p0) + continue; + if (last_len == p1 - p0 + && bcmp (last_family, p0, last_len) == 0) + continue; + last_len = p1 - p0; + last_family = p0; + family = intern_downcase (p0, last_len); + if (! memq_no_quit (family, list)) + list = Fcons (family, list); + } + + XFreeFontNames (names); + x_uncatch_errors (); + UNBLOCK_INPUT; + + return list; +} + +static struct font * +xfont_open (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Display *display = dpyinfo->display; + char name[256]; + int len; + unsigned long value; + Lisp_Object registry; + struct charset *encoding, *repertory; + struct font *font; + XFontStruct *xfont; + + /* At first, check if we know how to encode characters for this + font. */ + registry = AREF (entity, FONT_REGISTRY_INDEX); + if (font_registry_charsets (registry, &encoding, &repertory) < 0) + return NULL; + + if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0) + pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX)); + len = font_unparse_xlfd (entity, pixel_size, name, 256); + if (len <= 0) + return NULL; + + BLOCK_INPUT; + x_catch_errors (display); + xfont = XLoadQueryFont (display, name); + if (x_had_errors_p (display)) + { + /* This error is perhaps due to insufficient memory on X server. + Let's just ignore it. */ + x_clear_errors (display); + xfont = NULL; + } + x_uncatch_errors (); + UNBLOCK_INPUT; + + if (! xfont) + return NULL; + font = malloc (sizeof (struct font)); + font->format = Qx; + font->font.font = xfont; + font->entity = entity; + font->pixel_size = pixel_size; + font->driver = &xfont_driver; + font->font.name = malloc (len + 1); + if (! font->font.name) + { + XFreeFont (display, xfont); + free (font); + return NULL; + } + bcopy (name, font->font.name, len + 1); + font->font.charset = encoding->id; + font->encoding_charset = encoding->id; + font->repertory_charset = repertory ? repertory->id : -1; + font->ascent = xfont->ascent; + font->descent = xfont->descent; + + if (xfont->min_bounds.width == xfont->max_bounds.width) + { + /* Fixed width font. */ + font->font.average_width = font->font.space_width + = xfont->min_bounds.width; + } + else + { + XChar2b char2b; + XCharStruct *pcm; + + char2b.byte1 = 0x00, char2b.byte2 = 0x20; + pcm = xfont_get_pcm (xfont, &char2b); + if (pcm) + font->font.space_width = pcm->width; + else + font->font.space_width = xfont->max_bounds.width; + + font->font.average_width + = (XGetFontProperty (xfont, dpyinfo->Xatom_AVERAGE_WIDTH, &value) + ? (long) value / 10 : 0); + if (font->font.average_width < 0) + font->font.average_width = - font->font.average_width; + if (font->font.average_width == 0) + { + if (pcm) + { + int width = pcm->width; + for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++) + if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL) + width += pcm->width; + font->font.average_width = width / 95; + } + else + font->font.average_width = xfont->max_bounds.width; + } + } + font->min_width = xfont->min_bounds.width; + if (font->min_width <= 0) + font->min_width = font->font.space_width; + + BLOCK_INPUT; + /* Try to get the full name of FONT. Put it in FULL_NAME. */ + if (XGetFontProperty (xfont, XA_FONT, &value)) + { + char *full_name = NULL, *p0, *p; + int dashes = 0; + + p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);; + /* Count the number of dashes in the "full name". + If it is too few, this isn't really the font's full name, + so don't use it. + In X11R4, the fonts did not come with their canonical names + stored in them. */ + while (*p) + { + if (*p == '-') + dashes++; + p++; + } + + if (dashes >= 13) + { + full_name = (char *) malloc (p - p0 + 1); + if (full_name) + bcopy (p0, full_name, p - p0 + 1); + } + XFree (p0); + + if (full_name) + font->font.full_name = full_name; + else + font->font.full_name = font->font.name; + } + font->file_name = NULL; + + font->font.size = xfont->max_bounds.width; + font->font.height = xfont->ascent + xfont->descent; + font->font.baseline_offset + = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value) + ? (long) value : 0); + font->font.relative_compose + = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value) + ? (long) value : 0); + font->font.default_ascent + = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value) + ? (long) value : 0); + font->font.vertical_centering + = (STRINGP (Vvertical_centering_font_regexp) + && (fast_c_string_match_ignore_case + (Vvertical_centering_font_regexp, font->font.full_name) >= 0)); + + UNBLOCK_INPUT; + + dpyinfo->n_fonts++; + + /* Set global flag fonts_changed_p to non-zero if the font loaded + has a character with a smaller width than any other character + before, or if the font loaded has a smaller height than any other + font loaded before. If this happens, it will make a glyph matrix + reallocation necessary. */ + if (dpyinfo->n_fonts == 1) + { + dpyinfo->smallest_font_height = font->font.height; + dpyinfo->smallest_char_width = font->min_width; + fonts_changed_p = 1; + } + else + { + if (dpyinfo->smallest_font_height > font->font.height) + dpyinfo->smallest_font_height = font->font.height, fonts_changed_p |= 1; + if (dpyinfo->smallest_char_width > font->min_width) + dpyinfo->smallest_char_width = font->min_width, fonts_changed_p |= 1; + } + + return font; +} + +static void +xfont_close (f, font) + FRAME_PTR f; + struct font *font; +{ + BLOCK_INPUT; + XFreeFont (FRAME_X_DISPLAY (f), font->font.font); + UNBLOCK_INPUT; + + if (font->font.name != font->font.full_name) + free (font->font.full_name); + free (font->font.name); + free (font); + FRAME_X_DISPLAY_INFO (f)->n_fonts--; +} + +static int +xfont_prepare_face (f, face) + FRAME_PTR f; + struct face *face; +{ + BLOCK_INPUT; + XSetFont (FRAME_X_DISPLAY (f), face->gc, face->font->fid); + UNBLOCK_INPUT; + + return 0; +} + +#if 0 +static void +xfont_done_face (f, face) + FRAME_PTR f; + struct face *face; +{ + if (face->extra) + { + BLOCK_INPUT; + XFreeGC (FRAME_X_DISPLAY (f), (GC) face->extra); + UNBLOCK_INPUT; + face->extra = NULL; + } +} +#endif /* 0 */ + +static int +xfont_has_char (entity, c) + Lisp_Object entity; + int c; +{ + Lisp_Object registry = AREF (entity, FONT_REGISTRY_INDEX); + struct charset *repertory; + + if (font_registry_charsets (registry, NULL, &repertory) < 0) + return -1; + if (! repertory) + return -1; + return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory)); +} + +static unsigned +xfont_encode_char (font, c) + struct font *font; + int c; +{ + struct charset *charset; + unsigned code; + XChar2b char2b; + + charset = CHARSET_FROM_ID (font->encoding_charset); + code = ENCODE_CHAR (charset, c); + if (code == CHARSET_INVALID_CODE (charset)) + return FONT_INVALID_CODE; + if (font->repertory_charset >= 0) + { + charset = CHARSET_FROM_ID (font->repertory_charset); + return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset) + ? code : FONT_INVALID_CODE); + } + char2b.byte1 = code >> 8; + char2b.byte2 = code & 0xFF; + return (xfont_get_pcm (font->font.font, &char2b) ? code : FONT_INVALID_CODE); +} + +static int +xfont_text_extents (font, code, nglyphs, metrics) + struct font *font; + unsigned *code; + int nglyphs; + struct font_metrics *metrics; +{ + int width = 0; + int i, x; + + if (metrics) + bzero (metrics, sizeof (struct font_metrics)); + for (i = 0, x = 0; i < nglyphs; i++) + { + XChar2b char2b; + static XCharStruct *pcm; + + if (code[i] >= 0x10000) + continue; + char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF; + pcm = xfont_get_pcm (font->font.font, &char2b); + if (! pcm) + continue; + if (metrics->lbearing > width + pcm->lbearing) + metrics->lbearing = width + pcm->lbearing; + if (metrics->rbearing < width + pcm->rbearing) + metrics->rbearing = width + pcm->rbearing; + if (metrics->ascent < pcm->ascent) + metrics->ascent = pcm->ascent; + if (metrics->descent < pcm->descent) + metrics->descent = pcm->descent; + width += pcm->width; + } + if (metrics) + metrics->width = width; + return width; +} + +static int +xfont_draw (s, from, to, x, y, with_background) + struct glyph_string *s; + int from, to, x, y, with_background; +{ + XFontStruct *xfont = s->face->font; + int len = to - from; + GC gc = s->gc; + + if (gc != s->face->gc) + { + XGCValues xgcv; + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (s->f); + + XGetGCValues (s->display, gc, GCFont, &xgcv); + if (xgcv.font != xfont->fid) + XSetFont (s->display, gc, xfont->fid); + } + + if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0) + { + char *str; + int i; + USE_SAFE_ALLOCA; + + SAFE_ALLOCA (str, char *, len); + for (i = 0; i < len ; i++) + str[i] = XCHAR2B_BYTE2 (s->char2b + from + i); + if (with_background > 0) + XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), + gc, x, y, str, len); + else + XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), + gc, x, y, str, len); + SAFE_FREE (); + return s->nchars; + } + + if (with_background > 0) + XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), + gc, x, y, s->char2b + from, len); + else + XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), + gc, x, y, s->char2b + from, len); + + return len; +} + + +void +syms_of_xfont () +{ + xfont_driver.type = Qx; + register_font_driver (&xfont_driver, NULL); +} + +/* arch-tag: 23c5f366-a5ee-44b7-a3b7-90d6da7fd749 + (do not change this comment) */ diff --git a/src/xftfont.c b/src/xftfont.c new file mode 100644 index 00000000000..421bc34d493 --- /dev/null +++ b/src/xftfont.c @@ -0,0 +1,667 @@ +/* xftfont.c -- XFT font driver. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006, 2007 + National Institute of Advanced Industrial Science and Technology (AIST) + Registration Number H13PRO009 + +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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> +#include <X11/Xlib.h> +#include <X11/Xft/Xft.h> + +#include "lisp.h" +#include "dispextern.h" +#include "xterm.h" +#include "frame.h" +#include "blockinput.h" +#include "character.h" +#include "charset.h" +#include "fontset.h" +#include "font.h" +#include "ftfont.h" + +/* Xft font driver. */ + +static Lisp_Object Qxft; + +/* The actual structure for Xft font that can be casted to struct + font. */ + +struct xftfont_info +{ + struct font font; + Display *display; + int screen; + XftFont *xftfont; +#ifdef HAVE_LIBOTF + int maybe_otf; /* Flag to tell if this may be OTF or not. */ + OTF *otf; +#endif /* HAVE_LIBOTF */ +}; + +/* Structure pointed by (struct face *)->extra */ + +struct xftface_info +{ + XftColor xft_fg; /* color for face->foreground */ + XftColor xft_bg; /* color for face->background */ +}; + +static void xftfont_get_colors P_ ((FRAME_PTR, struct face *, GC gc, + struct xftface_info *, + XftColor *fg, XftColor *bg)); +static Font xftfont_default_fid P_ ((FRAME_PTR)); + + +/* Setup foreground and background colors of GC into FG and BG. If + XFTFACE_INFO is not NULL, reuse the colors in it if possible. BG + may be NULL. */ + +static void +xftfont_get_colors (f, face, gc, xftface_info, fg, bg) + FRAME_PTR f; + struct face *face; + GC gc; + struct xftface_info *xftface_info; + XftColor *fg, *bg; +{ + if (xftface_info && face->gc == gc) + { + *fg = xftface_info->xft_fg; + if (bg) + *bg = xftface_info->xft_bg; + } + else + { + XGCValues xgcv; + int fg_done = 0, bg_done = 0; + + BLOCK_INPUT; + XGetGCValues (FRAME_X_DISPLAY (f), gc, + GCForeground | GCBackground, &xgcv); + if (xftface_info) + { + if (xgcv.foreground == face->foreground) + *fg = xftface_info->xft_fg, fg_done = 1; + else if (xgcv.foreground == face->background) + *fg = xftface_info->xft_bg, fg_done = 1; + if (! bg) + bg_done = 1; + else if (xgcv.background == face->background) + *bg = xftface_info->xft_bg, bg_done = 1; + else if (xgcv.background == face->foreground) + *bg = xftface_info->xft_fg, bg_done = 1; + } + + if (fg_done + bg_done < 2) + { + XColor colors[2]; + + colors[0].pixel = fg->pixel = xgcv.foreground; + if (bg) + colors[1].pixel = bg->pixel = xgcv.background; + XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, + bg ? 2 : 1); + fg->color.alpha = 0xFFFF; + fg->color.red = colors[0].red; + fg->color.green = colors[0].green; + fg->color.blue = colors[0].blue; + if (bg) + { + bg->color.alpha = 0xFFFF; + bg->color.red = colors[1].red; + bg->color.green = colors[1].green; + bg->color.blue = colors[1].blue; + } + } + UNBLOCK_INPUT; + } +} + +/* Return the default Font ID on frame F. The Returned Font ID is + stored in the GC of the frame F, but the font is never used. So, + any ID is ok as long as it is valid. */ + +static Font +xftfont_default_fid (f) + FRAME_PTR f; +{ + static int fid_known; + static Font fid; + + if (! fid_known) + { + fid = XLoadFont (FRAME_X_DISPLAY (f), "fixed"); + if (! fid) + { + fid = XLoadFont (FRAME_X_DISPLAY (f), "*"); + if (! fid) + abort (); + } + fid_known = 1; + } + return fid; +} + + +static Lisp_Object xftfont_list P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object xftfont_match P_ ((Lisp_Object, Lisp_Object)); +static struct font *xftfont_open P_ ((FRAME_PTR, Lisp_Object, int)); +static void xftfont_close P_ ((FRAME_PTR, struct font *)); +static int xftfont_prepare_face P_ ((FRAME_PTR, struct face *)); +static void xftfont_done_face P_ ((FRAME_PTR, struct face *)); +static unsigned xftfont_encode_char P_ ((struct font *, int)); +static int xftfont_text_extents P_ ((struct font *, unsigned *, int, + struct font_metrics *)); +static int xftfont_draw P_ ((struct glyph_string *, int, int, int, int, int)); + +static int xftfont_anchor_point P_ ((struct font *, unsigned, int, + int *, int *)); +static int xftfont_end_for_frame P_ ((FRAME_PTR f)); + +struct font_driver xftfont_driver; + +static Lisp_Object +xftfont_list (frame, spec) + Lisp_Object frame; + Lisp_Object spec; +{ + Lisp_Object val = ftfont_driver.list (frame, spec); + int i; + + if (! NILP (val)) + for (i = 0; i < ASIZE (val); i++) + ASET (AREF (val, i), FONT_TYPE_INDEX, Qxft); + return val; +} + +static Lisp_Object +xftfont_match (frame, spec) + Lisp_Object frame; + Lisp_Object spec; +{ + Lisp_Object entity = ftfont_driver.match (frame, spec); + + if (VECTORP (entity)) + ASET (entity, FONT_TYPE_INDEX, Qxft); + return entity; +} + +extern Lisp_Object ftfont_font_format P_ ((FcPattern *)); + +static FcChar8 ascii_printable[95]; + +static struct font * +xftfont_open (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Display *display = FRAME_X_DISPLAY (f); + Lisp_Object val; + FcPattern *pattern, *pat = NULL; + FcChar8 *file; + struct xftfont_info *xftfont_info = NULL; + XFontStruct *xfont = NULL; + struct font *font; + double size = 0; + XftFont *xftfont = NULL; + int spacing; + char *name; + int len; + XGlyphInfo extents; + FT_Face ft_face; + + val = AREF (entity, FONT_EXTRA_INDEX); + if (XTYPE (val) != Lisp_Misc + || XMISCTYPE (val) != Lisp_Misc_Save_Value) + return NULL; + pattern = XSAVE_VALUE (val)->pointer; + if (FcPatternGetString (pattern, FC_FILE, 0, &file) != FcResultMatch) + return NULL; + + size = XINT (AREF (entity, FONT_SIZE_INDEX)); + if (size == 0) + size = pixel_size; + + pat = FcPatternCreate (); + FcPatternAddString (pat, FC_FILE, file); + FcPatternAddDouble (pat, FC_PIXEL_SIZE, pixel_size); + /*FcPatternAddBool (pat, FC_ANTIALIAS, FcTrue);*/ + val = AREF (entity, FONT_FAMILY_INDEX); + if (! NILP (val)) + FcPatternAddString (pat, FC_FAMILY, (FcChar8 *) SDATA (SYMBOL_NAME (val))); + FcConfigSubstitute (NULL, pat, FcMatchPattern); + + BLOCK_INPUT; + XftDefaultSubstitute (display, FRAME_X_SCREEN_NUMBER (f), pat); + xftfont = XftFontOpenPattern (display, pat); + /* We should not destroy PAT here because it is kept in XFTFONT and + destroyed automatically when XFTFONT is closed. */ + if (! xftfont) + goto err; + + xftfont_info = malloc (sizeof (struct xftfont_info)); + if (! xftfont_info) + goto err; + xfont = malloc (sizeof (XFontStruct)); + if (! xfont) + goto err; + xftfont_info->display = display; + xftfont_info->screen = FRAME_X_SCREEN_NUMBER (f); + xftfont_info->xftfont = xftfont; +#ifdef HAVE_LIBOTF + ft_face = XftLockFace (xftfont); + xftfont_info->maybe_otf = ft_face->face_flags & FT_FACE_FLAG_SFNT; + XftUnlockFace (xftfont); + xftfont_info->otf = NULL; +#endif /* HAVE_LIBOTF */ + + font = (struct font *) xftfont_info; + font->format = ftfont_font_format (xftfont->pattern); + font->entity = entity; + font->pixel_size = size; + font->driver = &xftfont_driver; + len = 96; + name = malloc (len); + while (name && font_unparse_fcname (entity, pixel_size, name, len) < 0) + { + char *new = realloc (name, len += 32); + + if (! new) + free (name); + name = new; + } + if (! name) + goto err; + font->font.full_name = font->font.name = name; + font->file_name = (char *) file; + font->font.size = xftfont->max_advance_width; + font->font.charset = font->encoding_charset = font->repertory_charset = -1; + + if (FcPatternGetInteger (xftfont->pattern, FC_SPACING, 0, &spacing) + != FcResultMatch) + spacing = FC_PROPORTIONAL; + if (! ascii_printable[0]) + { + int i; + for (i = 0; i < 95; i++) + ascii_printable[i] = ' ' + i; + } + if (spacing != FC_PROPORTIONAL) + { + font->font.average_width = font->font.space_width + = xftfont->max_advance_width; + XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents); + } + else + { + XftTextExtents8 (display, xftfont, ascii_printable, 1, &extents); + font->font.space_width = extents.xOff; + if (font->font.space_width <= 0) + /* dirty workaround */ + font->font.space_width = pixel_size; + XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents); + font->font.average_width = (font->font.space_width + extents.xOff) / 95; + } + UNBLOCK_INPUT; + + font->ascent = xftfont->ascent; + if (font->ascent < extents.y) + font->ascent = extents.y; + font->descent = xftfont->descent; + if (font->descent < extents.height - extents.y) + font->descent = extents.height - extents.y; + font->font.height = font->ascent + font->descent; + + /* Unfortunately Xft doesn't provide a way to get minimum char + width. So, we use space_width instead. */ + font->min_width = font->font.space_width; + + font->font.baseline_offset = 0; + font->font.relative_compose = 0; + font->font.default_ascent = 0; + font->font.vertical_centering = 0; + + /* Setup pseudo XFontStruct */ + xfont->fid = xftfont_default_fid (f); + xfont->ascent = font->ascent; + xfont->descent = font->descent; + xfont->max_bounds.descent = font->descent; + xfont->max_bounds.width = xftfont->max_advance_width; + xfont->min_bounds.width = font->font.space_width; + font->font.font = xfont; + + dpyinfo->n_fonts++; + + /* Set global flag fonts_changed_p to non-zero if the font loaded + has a character with a smaller width than any other character + before, or if the font loaded has a smaller height than any other + font loaded before. If this happens, it will make a glyph matrix + reallocation necessary. */ + if (dpyinfo->n_fonts == 1) + { + dpyinfo->smallest_font_height = font->font.height; + dpyinfo->smallest_char_width = font->min_width; + fonts_changed_p = 1; + } + else + { + if (dpyinfo->smallest_font_height > font->font.height) + dpyinfo->smallest_font_height = font->font.height, + fonts_changed_p |= 1; + if (dpyinfo->smallest_char_width > font->min_width) + dpyinfo->smallest_char_width = font->min_width, + fonts_changed_p |= 1; + } + + return font; + + err: + if (xftfont) XftFontClose (display, xftfont); + UNBLOCK_INPUT; + if (xftfont_info) free (xftfont_info); + if (xfont) free (xfont); + return NULL; +} + +static void +xftfont_close (f, font) + FRAME_PTR f; + struct font *font; +{ + struct xftfont_info *xftfont_info = (struct xftfont_info *) font; + +#ifdef HAVE_LIBOTF + if (xftfont_info->otf) + OTF_close (xftfont_info->otf); +#endif + XftFontClose (xftfont_info->display, xftfont_info->xftfont); + if (font->font.name) + free (font->font.name); + free (font); + FRAME_X_DISPLAY_INFO (f)->n_fonts--; +} + +static int +xftfont_prepare_face (f, face) + FRAME_PTR f; + struct face *face; +{ + struct xftface_info *xftface_info; + +#if 0 + /* This doesn't work if face->ascii_face doesn't use an Xft font. */ + if (face != face->ascii_face) + { + face->extra = face->ascii_face->extra; + return 0; + } +#endif + + xftface_info = malloc (sizeof (struct xftface_info)); + if (! xftface_info) + return -1; + + BLOCK_INPUT; + xftfont_get_colors (f, face, face->gc, NULL, + &xftface_info->xft_fg, &xftface_info->xft_bg); + UNBLOCK_INPUT; + + face->extra = xftface_info; + return 0; +} + +static void +xftfont_done_face (f, face) + FRAME_PTR f; + struct face *face; +{ + struct xftface_info *xftface_info; + +#if 0 + /* This doesn't work if face->ascii_face doesn't use an Xft font. */ + if (face != face->ascii_face + || ! face->extra) + return; +#endif + + xftface_info = (struct xftface_info *) face->extra; + if (xftface_info) + { + free (xftface_info); + face->extra = NULL; + } +} + +static unsigned +xftfont_encode_char (font, c) + struct font *font; + int c; +{ + struct xftfont_info *xftfont_info = (struct xftfont_info *) font; + unsigned code = XftCharIndex (xftfont_info->display, xftfont_info->xftfont, + (FcChar32) c); + + return (code ? code : FONT_INVALID_CODE); +} + +static int +xftfont_text_extents (font, code, nglyphs, metrics) + struct font *font; + unsigned *code; + int nglyphs; + struct font_metrics *metrics; +{ + struct xftfont_info *xftfont_info = (struct xftfont_info *) font; + XGlyphInfo extents; + + BLOCK_INPUT; + XftGlyphExtents (xftfont_info->display, xftfont_info->xftfont, code, nglyphs, + &extents); + UNBLOCK_INPUT; + if (metrics) + { + metrics->lbearing = - extents.x; + metrics->rbearing = - extents.x + extents.width; + metrics->width = extents.xOff; + metrics->ascent = extents.y; + metrics->descent = extents.height - extents.y; + } + return extents.xOff; +} + +static XftDraw * +xftfont_get_xft_draw (f) + FRAME_PTR f; +{ + XftDraw *xft_draw = font_get_frame_data (f, &xftfont_driver);; + + if (! xft_draw) + { + BLOCK_INPUT; + xft_draw= XftDrawCreate (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f)); + UNBLOCK_INPUT; + if (! xft_draw) + abort (); + font_put_frame_data (f, &xftfont_driver, xft_draw); + } + return xft_draw; +} + +static int +xftfont_draw (s, from, to, x, y, with_background) + struct glyph_string *s; + int from, to, x, y, with_background; +{ + FRAME_PTR f = s->f; + struct face *face = s->face; + struct xftfont_info *xftfont_info = (struct xftfont_info *) s->font_info; + struct xftface_info *xftface_info = NULL; + XftDraw *xft_draw = xftfont_get_xft_draw (f); + FT_UInt *code; + XftColor fg, bg; + XRectangle r; + int len = to - from; + int i; + + if (s->font_info == face->font_info) + xftface_info = (struct xftface_info *) face->extra; + xftfont_get_colors (f, face, s->gc, xftface_info, + &fg, with_background ? &bg : NULL); + BLOCK_INPUT; + if (s->num_clips > 0) + XftDrawSetClipRectangles (xft_draw, 0, 0, s->clip, s->num_clips); + else + XftDrawSetClip (xft_draw, NULL); + + if (with_background) + { + struct font *font = (struct font *) face->font_info; + + XftDrawRect (xft_draw, &bg, + x, y - face->font->ascent, s->width, font->font.height); + } + code = alloca (sizeof (FT_UInt) * len); + for (i = 0; i < len; i++) + code[i] = ((XCHAR2B_BYTE1 (s->char2b + from + i) << 8) + | XCHAR2B_BYTE2 (s->char2b + from + i)); + + XftDrawGlyphs (xft_draw, &fg, xftfont_info->xftfont, + x, y, code, len); + UNBLOCK_INPUT; + + return len; +} + +static int +xftfont_anchor_point (font, code, index, x, y) + struct font *font; + unsigned code; + int index; + int *x, *y; +{ + struct xftfont_info *xftfont_info = (struct xftfont_info *) font; + FT_Face ft_face = XftLockFace (xftfont_info->xftfont); + int result; + + if (FT_Load_Glyph (ft_face, code, FT_LOAD_DEFAULT) != 0) + result = -1; + else if (ft_face->glyph->format != FT_GLYPH_FORMAT_OUTLINE) + result = -1; + else if (index >= ft_face->glyph->outline.n_points) + result = -1; + else + { + *x = ft_face->glyph->outline.points[index].x; + *y = ft_face->glyph->outline.points[index].y; + } + XftUnlockFace (xftfont_info->xftfont); + return result; +} + +static int +xftfont_end_for_frame (f) + FRAME_PTR f; +{ + XftDraw *xft_draw = font_get_frame_data (f, &xftfont_driver); + + if (xft_draw) + { + BLOCK_INPUT; + XftDrawDestroy (xft_draw); + UNBLOCK_INPUT; + font_put_frame_data (f, &xftfont_driver, NULL); + } + return 0; +} + +#ifdef HAVE_LIBOTF +#ifdef HAVE_M17N_FLT +static Lisp_Object +xftfont_shape (lgstring) + Lisp_Object lgstring; +{ + struct font *font; + struct xftfont_info *xftfont_info; + int result; + FT_Face ft_face; + + CHECK_FONT_GET_OBJECT (LGSTRING_FONT (lgstring), font); + xftfont_info = (struct xftfont_info *) font; + if (! xftfont_info->maybe_otf) + return Qnil; + ft_face = XftLockFace (xftfont_info->xftfont); + if (! xftfont_info->otf) + { + OTF *otf = OTF_open_ft_face (ft_face); + + if (! otf || OTF_get_table (otf, "head") < 0) + { + if (otf) + OTF_close (otf); + xftfont_info->maybe_otf = 0; + XftUnlockFace (xftfont_info->xftfont); + return 0; + } + xftfont_info->otf = otf; + } + + result = ftfont_shape_by_flt (lgstring, font, ft_face, xftfont_info->otf); + XftUnlockFace (xftfont_info->xftfont); + return result; +} +#endif /* HAVE_M17N_FLT */ +#endif /* HAVE_LIBOTF */ + +void +syms_of_xftfont () +{ + DEFSYM (Qxft, "xft"); + + xftfont_driver = ftfont_driver; + xftfont_driver.type = Qxft; + xftfont_driver.get_cache = xfont_driver.get_cache; + xftfont_driver.list = xftfont_list; + xftfont_driver.match = xftfont_match; + xftfont_driver.open = xftfont_open; + xftfont_driver.close = xftfont_close; + xftfont_driver.prepare_face = xftfont_prepare_face; + xftfont_driver.done_face = xftfont_done_face; + xftfont_driver.encode_char = xftfont_encode_char; + xftfont_driver.text_extents = xftfont_text_extents; + xftfont_driver.draw = xftfont_draw; + xftfont_driver.anchor_point = xftfont_anchor_point; + xftfont_driver.end_for_frame = xftfont_end_for_frame; +#ifdef HAVE_LIBOTF +#ifdef HAVE_M17N_FLT + xftfont_driver.shape = xftfont_shape; +#endif /* HAVE_M17N_FLT */ +#endif /* HAVE_LIBOTF */ + + register_font_driver (&xftfont_driver, NULL); +} + +/* arch-tag: 64ec61bf-7c8e-4fe6-b953-c6a85d5e1605 + (do not change this comment) */ diff --git a/src/xmenu.c b/src/xmenu.c index 14c72397110..15aab98f9c5 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -248,10 +248,10 @@ menubar_id_to_frame (id) Lisp_Object tail, frame; FRAME_PTR f; - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { frame = XCAR (tail); - if (!GC_FRAMEP (frame)) + if (!FRAMEP (frame)) continue; f = XFRAME (frame); if (!FRAME_WINDOW_P (f)) @@ -1561,10 +1561,10 @@ show_help_event (f, widget, help) xt_or_gtk_widget frame_widget = XtParent (widget); Lisp_Object tail; - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { frame = XCAR (tail); - if (GC_FRAMEP (frame) + if (FRAMEP (frame) && (f = XFRAME (frame), FRAME_X_P (f) && f->output_data.x->widget == frame_widget)) break; @@ -1630,7 +1630,7 @@ menu_highlight_callback (widget, id, call_data) static void find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data) FRAME_PTR f; - int menu_bar_items_used; + EMACS_INT menu_bar_items_used; Lisp_Object vector; void *client_data; { diff --git a/src/xrdb.c b/src/xrdb.c index 79f1da81a41..a1dc47c0b07 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -610,6 +610,29 @@ x_load_resources (display, xrm_string, myname, myclass) #endif /* not USE_MOTIF */ +#ifdef HAVE_X_I18N + { +#ifdef USE_MOTIF + Bool motif = True; +#else /* not USE_MOTIF */ + Bool motif = False; +#endif /* not USE_MOTIF */ + /* Setup the default fontSet resource. */ + extern char *xic_create_fontsetname P_ ((char *base_fontname, Bool motif)); + char *fontsetname = xic_create_fontsetname (helv, motif); + int len = strlen (fontsetname); + char *buf = line; + + /* fontsetname may be very long. */ + if (len + 16 > 256) + buf = alloca (len + 16); + sprintf (buf, "Emacs*fontSet: %s", fontsetname); + XrmPutLineResource (&rdb, buf); + if (fontsetname != helv) + xfree (fontsetname); + } +#endif /* HAVE_X_I18N */ + user_database = get_user_db (display); /* Figure out what the "customization string" is, so we can use it diff --git a/src/xselect.c b/src/xselect.c index 45907b30be4..53debec8c07 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -123,13 +123,6 @@ Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, static Lisp_Object Vx_lost_selection_functions; static Lisp_Object Vx_sent_selection_functions; -/* Coding system for communicating with other X clients via selection - and clipboard. */ -static Lisp_Object Vselection_coding_system; - -/* Coding system for the next communicating with other X clients. */ -static Lisp_Object Vnext_selection_coding_system; - static Lisp_Object Qforeign_selection; /* If this is a smaller number than the max-request-size of the display, @@ -3006,30 +2999,6 @@ This hook doesn't let you change the behavior of Emacs's selection replies, it merely informs you that they have happened. */); Vx_sent_selection_functions = Qnil; - DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system, - doc: /* Coding system for communicating with other X clients. - -When sending text via selection and clipboard, if the requested -data-type is not "UTF8_STRING", the text is encoded by this coding -system. - -When receiving text, if the data-type of the received text is not -"UTF8_STRING", it is decoded by this coding system. - -See also the documentation of the variable `x-select-request-type' how -to control which data-type to request for receiving text. - -The default value is `compound-text-with-extensions'. */); - Vselection_coding_system = intern ("compound-text-with-extensions"); - - DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system, - doc: /* Coding system for the next communication with other X clients. -Usually, `selection-coding-system' is used for communicating with -other X clients. But, if this variable is set, it is used for the -next communication only. After the communication, this variable is -set to nil. */); - Vnext_selection_coding_system = Qnil; - DEFVAR_INT ("x-selection-timeout", &x_selection_timeout, doc: /* Number of milliseconds to wait for a selection reply. If the selection owner doesn't reply in this time, we give up. diff --git a/src/xterm.c b/src/xterm.c index 895d61df714..1d39801a72d 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -67,6 +67,7 @@ Boston, MA 02110-1301, USA. */ /* #include <sys/param.h> */ #include "charset.h" +#include "character.h" #include "coding.h" #include "ccl.h" #include "frame.h" @@ -100,6 +101,10 @@ Boston, MA 02110-1301, USA. */ #include "gtkutil.h" #endif +#ifdef USE_FONT_BACKEND +#include "font.h" +#endif /* USE_FONT_BACKEND */ + #ifdef USE_LUCID extern int xlwmenu_window_p P_ ((Widget w, Window window)); extern void xlwmenu_redisplay P_ ((Widget)); @@ -872,7 +877,8 @@ XTreset_terminal_modes (struct terminal *terminal) /* Function prototypes of this page. */ -static int x_encode_char P_ ((int, XChar2b *, struct font_info *, int *)); +static int x_encode_char P_ ((int, XChar2b *, struct font_info *, + struct charset *, int *)); /* Get metrics of character CHAR2B in FONT. Value is null if CHAR2B @@ -951,13 +957,13 @@ x_per_char_metric (font, char2b, font_type) the two-byte form of C. Encoding is returned in *CHAR2B. */ static int -x_encode_char (c, char2b, font_info, two_byte_p) +x_encode_char (c, char2b, font_info, charset, two_byte_p) int c; XChar2b *char2b; struct font_info *font_info; + struct charset *charset; int *two_byte_p; { - int charset = CHAR_CHARSET (c); XFontStruct *font = font_info->font; /* FONT_INFO may define a scheme by which to encode byte1 and byte2. @@ -971,31 +977,31 @@ x_encode_char (c, char2b, font_info, two_byte_p) check_ccl_update (ccl); if (CHARSET_DIMENSION (charset) == 1) { - ccl->reg[0] = charset; + ccl->reg[0] = CHARSET_ID (charset); ccl->reg[1] = char2b->byte2; ccl->reg[2] = -1; } else { - ccl->reg[0] = charset; + ccl->reg[0] = CHARSET_ID (charset); ccl->reg[1] = char2b->byte1; ccl->reg[2] = char2b->byte2; } - ccl_driver (ccl, NULL, NULL, 0, 0, NULL); + ccl_driver (ccl, NULL, NULL, 0, 0, Qnil); /* We assume that MSBs are appropriately set/reset by CCL program. */ if (font->max_byte1 == 0) /* 1-byte font */ - char2b->byte1 = 0, char2b->byte2 = ccl->reg[1]; + STORE_XCHAR2B (char2b, 0, ccl->reg[1]); else - char2b->byte1 = ccl->reg[1], char2b->byte2 = ccl->reg[2]; + STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]); } - else if (font_info->encoding[charset]) + else if (font_info->encoding_type) { /* Fixed encoding scheme. See fontset.h for the meaning of the encoding numbers. */ - int enc = font_info->encoding[charset]; + unsigned char enc = font_info->encoding_type; if ((enc == 1 || enc == 2) && CHARSET_DIMENSION (charset) == 2) @@ -1123,15 +1129,20 @@ x_set_mouse_face_gc (s) face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); if (s->first_glyph->type == CHAR_GLYPH) - face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch); + face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil); else - face_id = FACE_FOR_CHAR (s->f, face, 0); + face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil); s->face = FACE_FROM_ID (s->f, face_id); PREPARE_FACE_FOR_DISPLAY (s->f, s->face); /* If font in this face is same as S->font, use it. */ if (s->font == s->face->font) s->gc = s->face->gc; +#ifdef USE_FONT_BACKEND + else if (enable_font_backend) + /* No need of setting a font for s->gc. */ + s->gc = s->face->gc; +#endif /* USE_FONT_BACKEND */ else { /* Otherwise construct scratch_cursor_gc with values from FACE @@ -1226,15 +1237,60 @@ static INLINE void x_set_glyph_string_clipping (s) struct glyph_string *s; { +#ifdef USE_FONT_BACKEND + XRectangle *r = s->clip; +#else + XRectangle r[2]; +#endif + int n = get_glyph_string_clip_rects (s, r, 2); + + if (n > 0) + XSetClipRectangles (s->display, s->gc, 0, 0, r, n, Unsorted); +#ifdef USE_FONT_BACKEND + s->num_clips = n; +#endif +} + + +/* Set SRC's clipping for output of glyph string DST. This is called + when we are drawing DST's left_overhang or right_overhang only in + the area of SRC. */ + +static void +x_set_glyph_string_clipping_exactly (src, dst) + struct glyph_string *src, *dst; +{ XRectangle r; - get_glyph_string_clip_rect (s, &r); - XSetClipRectangles (s->display, s->gc, 0, 0, &r, 1, Unsorted); + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + r.x = src->x; + r.width = src->width; + r.y = src->y; + r.height = src->height; + dst->clip[0] = r; + dst->num_clips = 1; + } + else + { +#endif /* USE_FONT_BACKEND */ + struct glyph_string *clip_head = src->clip_head; + struct glyph_string *clip_tail = src->clip_tail; + + /* This foces clipping just this glyph string. */ + src->clip_head = src->clip_tail = src; + get_glyph_string_clip_rect (src, &r); + src->clip_head = clip_head, src->clip_tail = clip_tail; +#ifdef USE_FONT_BACKEND + } +#endif /* USE_FONT_BACKEND */ + XSetClipRectangles (dst->display, dst->gc, 0, 0, &r, 1, Unsorted); } /* RIF: - Compute left and right overhang of glyph string S. If S is a glyph - string for a composition, assume overhangs don't exist. */ + Compute left and right overhang of glyph string S. */ static void x_compute_glyph_string_overhangs (s) @@ -1245,11 +1301,34 @@ x_compute_glyph_string_overhangs (s) { XCharStruct cs; int direction, font_ascent, font_descent; + +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + unsigned *code = alloca (sizeof (unsigned) * s->nchars); + struct font *font = (struct font *) s->font_info; + struct font_metrics metrics; + int i; + + for (i = 0; i < s->nchars; i++) + code[i] = (s->char2b[i].byte1 << 8) | s->char2b[i].byte2; + font->driver->text_extents (font, code, s->nchars, &metrics); + cs.rbearing = metrics.rbearing; + cs.lbearing = metrics.lbearing; + cs.width = metrics.width; + } + else +#endif /* USE_FONT_BACKEND */ XTextExtents16 (s->font, s->char2b, s->nchars, &direction, &font_ascent, &font_descent, &cs); s->right_overhang = cs.rbearing > cs.width ? cs.rbearing - cs.width : 0; s->left_overhang = cs.lbearing < 0 ? -cs.lbearing : 0; } + else if (s->cmp) + { + s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width; + s->left_overhang = - s->cmp->lbearing; + } } @@ -1339,6 +1418,26 @@ x_draw_glyph_string_foreground (s) x += g->pixel_width; } } +#ifdef USE_FONT_BACKEND + else if (enable_font_backend) + { + int boff = s->font_info->baseline_offset; + struct font *font = (struct font *) s->font_info; + int y; + + if (s->font_info->vertical_centering) + boff = VCENTER_BASELINE_OFFSET (s->font, s->f) - boff; + + y = s->ybase - boff; + if (s->for_overlaps + || (s->background_filled_p && s->hl != DRAW_CURSOR)) + font->driver->draw (s, 0, s->nchars, x, y, 0); + else + font->driver->draw (s, 0, s->nchars, x, y, 1); + if (s->face->overstrike) + font->driver->draw (s, 0, s->nchars, x + 1, y, 0); + } +#endif /* USE_FONT_BACKEND */ else { char *char1b = (char *) s->char2b; @@ -1398,11 +1497,11 @@ static void x_draw_composite_glyph_string_foreground (s) struct glyph_string *s; { - int i, x; + int i, j, x; /* If first glyph of S has a left box line, start drawing the text of S to the right of that box line. */ - if (s->face->box != FACE_NO_BOX + if (s->face && s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) x = s->x + eabs (s->face->box_line_width); else @@ -1421,21 +1520,79 @@ x_draw_composite_glyph_string_foreground (s) XDrawRectangle (s->display, s->window, s->gc, x, s->y, s->width - 1, s->height - 1); } - else +#ifdef USE_FONT_BACKEND + else if (enable_font_backend) { - for (i = 0; i < s->nchars; i++, ++s->gidx) + struct font *font = (struct font *) s->font_info; + int y = s->ybase; + int width = 0; + + if (s->cmp->method == COMPOSITION_WITH_GLYPH_STRING) { - XDrawString16 (s->display, s->window, s->gc, - x + s->cmp->offsets[s->gidx * 2], - s->ybase - s->cmp->offsets[s->gidx * 2 + 1], - s->char2b + i, 1); - if (s->face->overstrike) - XDrawString16 (s->display, s->window, s->gc, - x + s->cmp->offsets[s->gidx * 2] + 1, - s->ybase - s->cmp->offsets[s->gidx * 2 + 1], - s->char2b + i, 1); + Lisp_Object gstring = AREF (XHASH_TABLE (composition_hash_table) + ->key_and_value, + s->cmp->hash_index * 2); + int from; + + for (i = from = 0; i < s->nchars; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring, i); + Lisp_Object adjustment = LGLYPH_ADJUSTMENT (g); + int xoff, yoff, wadjust; + + if (! VECTORP (adjustment)) + { + width += LGLYPH_WIDTH (g); + continue; + } + if (from < i) + { + font->driver->draw (s, from, i, x, y, 0); + x += width; + } + xoff = XINT (AREF (adjustment, 0)); + yoff = XINT (AREF (adjustment, 1)); + wadjust = XINT (AREF (adjustment, 2)); + + font->driver->draw (s, i, i + 1, x + xoff, y + yoff, 0); + x += wadjust; + from = i + 1; + width = 0; + } + if (from < i) + font->driver->draw (s, from, i, x, y, 0); + } + else + { + for (i = 0, j = s->gidx; i < s->nchars; i++, j++) + if (COMPOSITION_GLYPH (s->cmp, j) != '\t') + { + int xx = x + s->cmp->offsets[j * 2]; + int yy = y - s->cmp->offsets[j * 2 + 1]; + + font->driver->draw (s, j, j + 1, xx, yy, 0); + if (s->face->overstrike) + font->driver->draw (s, j, j + 1, xx + 1, yy, 0); + } } } +#endif /* USE_FONT_BACKEND */ + else + { + for (i = 0, j = s->gidx; i < s->nchars; i++, j++) + if (s->face) + { + XDrawString16 (s->display, s->window, s->gc, + x + s->cmp->offsets[j * 2], + s->ybase - s->cmp->offsets[j * 2 + 1], + s->char2b + j, 1); + if (s->face->overstrike) + XDrawString16 (s->display, s->window, s->gc, + x + s->cmp->offsets[j * 2] + 1, + s->ybase - s->cmp->offsets[j * 2 + 1], + s->char2b + j, 1); + } + } } @@ -1470,8 +1627,8 @@ x_frame_of_widget (widget) /* Look for a frame with that top-level widget. Allocate the color on that frame to get the right gamma correction value. */ - for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail)) - if (GC_FRAMEP (XCAR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) + if (FRAMEP (XCAR (tail)) && (f = XFRAME (XCAR (tail)), (FRAME_X_P (f) && f->output_data.nothing != 1 @@ -2682,15 +2839,25 @@ x_draw_glyph_string (s) { int relief_drawn_p = 0; - /* If S draws into the background of its successor, draw the - background of the successor first so that S can draw into it. + /* If S draws into the background of its successors, draw the + background of the successors first so that S can draw into it. This makes S->next use XDrawString instead of XDrawImageString. */ if (s->next && s->right_overhang && !s->for_overlaps) { - xassert (s->next->img == NULL); - x_set_glyph_string_gc (s->next); - x_set_glyph_string_clipping (s->next); - x_draw_glyph_string_background (s->next, 1); + int width; + struct glyph_string *next; + + for (width = 0, next = s->next; next; + width += next->width, next = next->next) + if (next->first_glyph->type != IMAGE_GLYPH) + { + x_set_glyph_string_gc (next); + x_set_glyph_string_clipping (next); + x_draw_glyph_string_background (next, 1); +#ifdef USE_FONT_BACKEND + next->num_clips = 0; +#endif /* USE_FONT_BACKEND */ + } } /* Set up S->gc, set clipping and draw S. */ @@ -2710,6 +2877,12 @@ x_draw_glyph_string (s) x_set_glyph_string_clipping (s); relief_drawn_p = 1; } + else if ((s->prev && s->prev->hl != s->hl && s->left_overhang) + || (s->next && s->next->hl != s->hl && s->right_overhang)) + /* We must clip just this glyph. left_overhang part has already + drawn when s->prev was drawn, and right_overhang part will be + drawn later when s->next is drawn. */ + x_set_glyph_string_clipping_exactly (s, s); else x_set_glyph_string_clipping (s); @@ -2752,26 +2925,45 @@ x_draw_glyph_string (s) int y; /* Get the underline thickness. Default is 1 pixel. */ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + /* In the future, we must use information of font. */ + h = 1; + else +#endif /* USE_FONT_BACKEND */ if (!XGetFontProperty (s->font, XA_UNDERLINE_THICKNESS, &h)) h = 1; - y = s->y + s->height - h; - if (!x_underline_at_descent_line) - { - /* Get the underline position. This is the recommended - vertical offset in pixels from the baseline to the top of - the underline. This is a signed value according to the - specs, and its default is - - ROUND ((maximum descent) / 2), with - ROUND(x) = floor (x + 0.5) */ - - if (x_use_underline_position_properties - && XGetFontProperty (s->font, XA_UNDERLINE_POSITION, &tem)) - y = s->ybase + (long) tem; - else if (s->face->font) - y = s->ybase + (s->face->font->max_bounds.descent + 1) / 2; - } +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { + if (s->face->font) + /* In the future, we must use information of font. */ + y = s->ybase + (s->face->font->max_bounds.descent + 1) / 2; + else + y = s->y + s->height - h; + } + else +#endif + { + y = s->y + s->height - h; + if (!x_underline_at_descent_line) + { + /* Get the underline position. This is the recommended + vertical offset in pixels from the baseline to the top of + the underline. This is a signed value according to the + specs, and its default is + + ROUND ((maximum descent) / 2), with + ROUND(x) = floor (x + 0.5) */ + + if (x_use_underline_position_properties + && XGetFontProperty (s->font, XA_UNDERLINE_POSITION, &tem)) + y = s->ybase + (long) tem; + else if (s->face->font) + y = s->ybase + (s->face->font->max_bounds.descent + 1) / 2; + } + } if (s->face->underline_defaulted_p) XFillRectangle (s->display, s->window, s->gc, @@ -2829,10 +3021,67 @@ x_draw_glyph_string (s) /* Draw relief if not yet drawn. */ if (!relief_drawn_p && s->face->box != FACE_NO_BOX) x_draw_glyph_string_box (s); + + if (s->prev) + { + struct glyph_string *prev; + + for (prev = s->prev; prev; prev = prev->prev) + if (prev->hl != s->hl + && prev->x + prev->width + prev->right_overhang > s->x) + { + /* As prev was drawn while clipped to its own area, we + must draw the right_overhang part using s->hl now. */ + enum draw_glyphs_face save = prev->hl; + + prev->hl = s->hl; + x_set_glyph_string_gc (prev); + x_set_glyph_string_clipping_exactly (s, prev); + if (prev->first_glyph->type == CHAR_GLYPH) + x_draw_glyph_string_foreground (prev); + else + x_draw_composite_glyph_string_foreground (prev); + XSetClipMask (prev->display, prev->gc, None); + prev->hl = save; +#ifdef USE_FONT_BACKEND + prev->num_clips = 0; +#endif /* USE_FONT_BACKEND */ + } + } + + if (s->next) + { + struct glyph_string *next; + + for (next = s->next; next; next = next->next) + if (next->hl != s->hl + && next->x - next->left_overhang < s->x + s->width) + { + /* As next will be drawn while clipped to its own area, + we must draw the left_overhang part using s->hl now. */ + enum draw_glyphs_face save = next->hl; + + next->hl = s->hl; + x_set_glyph_string_gc (next); + x_set_glyph_string_clipping_exactly (s, next); + if (next->first_glyph->type == CHAR_GLYPH) + x_draw_glyph_string_foreground (next); + else + x_draw_composite_glyph_string_foreground (next); + XSetClipMask (next->display, next->gc, None); + next->hl = save; +#ifdef USE_FONT_BACKEND + next->num_clips = 0; +#endif /* USE_FONT_BACKEND */ + } + } } /* Reset clipping. */ XSetClipMask (s->display, s->gc, None); +#ifdef USE_FONT_BACKEND + s->num_clips = 0; +#endif /* USE_FONT_BACKEND */ } /* Shift display to make room for inserted glyphs. */ @@ -3285,9 +3534,9 @@ x_focus_changed (type, state, dpyinfo, frame, bufp) /* Don't stop displaying the initial startup message for a switch-frame event we don't need. */ - if (GC_NILP (Vterminal_frame) - && GC_CONSP (Vframe_list) - && !GC_NILP (XCDR (Vframe_list))) + if (NILP (Vterminal_frame) + && CONSP (Vframe_list) + && !NILP (XCDR (Vframe_list))) { bufp->kind = FOCUS_IN_EVENT; XSETFRAME (bufp->frame_or_window, frame); @@ -3397,7 +3646,7 @@ x_frame_rehighlight (dpyinfo) if (dpyinfo->x_focus_frame) { dpyinfo->x_highlight_frame - = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame))) + = ((FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame))) ? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame)) : dpyinfo->x_focus_frame); if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame)) @@ -3938,15 +4187,13 @@ x_window_to_scroll_bar (display, window_id) window_id = (Window) xg_get_scroll_id_for_window (display, window_id); #endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */ - for (tail = Vframe_list; - XGCTYPE (tail) == Lisp_Cons; - tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { Lisp_Object frame, bar, condemned; frame = XCAR (tail); /* All elements of Vframe_list should be frames. */ - if (! GC_FRAMEP (frame)) + if (! FRAMEP (frame)) abort (); if (! FRAME_X_P (XFRAME (frame))) @@ -3958,9 +4205,9 @@ x_window_to_scroll_bar (display, window_id) for (bar = FRAME_SCROLL_BARS (XFRAME (frame)); /* This trick allows us to search both the ordinary and condemned scroll bar lists with one loop. */ - ! GC_NILP (bar) || (bar = condemned, + ! NILP (bar) || (bar = condemned, condemned = Qnil, - ! GC_NILP (bar)); + ! NILP (bar)); bar = XSCROLL_BAR (bar)->next) if (XSCROLL_BAR (bar)->x_window == window_id && FRAME_X_DISPLAY (XFRAME (frame)) == display) @@ -3982,9 +4229,7 @@ x_window_to_menu_bar (window) { Lisp_Object tail; - for (tail = Vframe_list; - XGCTYPE (tail) == Lisp_Cons; - tail = XCDR (tail)) + for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail)) { if (FRAME_X_P (XFRAME (XCAR (tail)))) { @@ -5396,7 +5641,7 @@ x_scroll_bar_handle_click (bar, event, emacs_event) XEvent *event; struct input_event *emacs_event; { - if (! GC_WINDOWP (bar->window)) + if (! WINDOWP (bar->window)) abort (); emacs_event->kind = SCROLL_BAR_CLICK_EVENT; @@ -5491,7 +5736,7 @@ x_scroll_bar_note_movement (bar, event) XSETVECTOR (last_mouse_scroll_bar, bar); /* If we're dragging the bar, display it. */ - if (! GC_NILP (bar->dragging)) + if (! NILP (bar->dragging)) { /* Where should the handle be now? */ int new_start = event->xmotion.y - XINT (bar->dragging); @@ -6368,41 +6613,14 @@ handle_one_xevent (dpyinfo, eventp, finish, hold_quit) goto done_keysym; } - /* Keysyms directly mapped to supported Unicode characters. */ - if ((keysym >= 0x01000000 && keysym <= 0x010033ff) - || (keysym >= 0x0100e000 && keysym <= 0x0100ffff)) + /* Keysyms directly mapped to Unicode characters. */ + if (keysym >= 0x01000000 && keysym <= 0x0110FFFF) { - int code = keysym & 0xFFFF, charset_id, c1, c2; - - if (code < 0x80) - { - inev.ie.kind = ASCII_KEYSTROKE_EVENT; - inev.ie.code = code; - } - else if (code < 0x100) - { - if (code < 0xA0) - charset_id = CHARSET_8_BIT_CONTROL; - else - charset_id = charset_latin_iso8859_1; - inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; - inev.ie.code = MAKE_CHAR (charset_id, code, 0); - } + if (keysym < 0x01000080) + inev.ie.kind = ASCII_KEYSTROKE_EVENT; else - { - if (code < 0x2500) - charset_id = charset_mule_unicode_0100_24ff, - code -= 0x100; - else if (code < 0xE000) - charset_id = charset_mule_unicode_2500_33ff, - code -= 0x2500; - else - charset_id = charset_mule_unicode_e000_ffff, - code -= 0xE000; - c1 = (code / 96) + 32, c2 = (code % 96) + 32; - inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; - inev.ie.code = MAKE_CHAR (charset_id, c1, c2); - } + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.code = keysym & 0xFFFFFF; goto done_keysym; } @@ -6507,54 +6725,54 @@ handle_one_xevent (dpyinfo, eventp, finish, hold_quit) register int c; int nchars, len; - /* The input should be decoded with `coding_system' - which depends on which X*LookupString function - we used just above and the locale. */ - setup_coding_system (coding_system, &coding); - coding.src_multibyte = 0; - coding.dst_multibyte = 1; - /* The input is converted to events, thus we can't - handle composition. Anyway, there's no XIM that - gives us composition information. */ - coding.composing = COMPOSITION_DISABLED; - - if (nbytes > 0) + for (i = 0, nchars = 0; i < nbytes; i++) + { + if (ASCII_BYTE_P (copy_bufptr[i])) + nchars++; + STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); + } + + if (nchars < nbytes) { /* Decode the input data. */ int require; unsigned char *p; - for (i = 0; i < nbytes; i++) - { - STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); - } - - require = decoding_buffer_size (&coding, nbytes); - p = (unsigned char *) alloca (require); + /* The input should be decoded with `coding_system' + which depends on which X*LookupString function + we used just above and the locale. */ + setup_coding_system (coding_system, &coding); + coding.src_multibyte = 0; + coding.dst_multibyte = 1; + /* The input is converted to events, thus we can't + handle composition. Anyway, there's no XIM that + gives us composition information. */ + coding.common_flags &= ~CODING_ANNOTATION_MASK; + + require = MAX_MULTIBYTE_LENGTH * nbytes; + coding.destination = alloca (require); + coding.dst_bytes = require; coding.mode |= CODING_MODE_LAST_BLOCK; - /* We explicitly disable composition handling because - key data should not contain any composition sequence. */ - coding.composing = COMPOSITION_DISABLED; - decode_coding (&coding, copy_bufptr, p, nbytes, require); + decode_coding_c_string (&coding, copy_bufptr, nbytes, Qnil); nbytes = coding.produced; nchars = coding.produced_char; - copy_bufptr = p; + copy_bufptr = coding.destination; + } - /* Convert the input data to a sequence of - character events. */ - for (i = 0; i < nbytes; i += len) - { - if (nchars == nbytes) - c = copy_bufptr[i], len = 1; - else - c = STRING_CHAR_AND_LENGTH (copy_bufptr + i, - nbytes - i, len); - inev.ie.kind = (SINGLE_BYTE_CHAR_P (c) - ? ASCII_KEYSTROKE_EVENT - : MULTIBYTE_CHAR_KEYSTROKE_EVENT); - inev.ie.code = c; - kbd_buffer_store_event_hold (&inev.ie, hold_quit); - } + /* Convert the input data to a sequence of + character events. */ + for (i = 0; i < nbytes; i += len) + { + if (nchars == nbytes) + c = copy_bufptr[i], len = 1; + else + c = STRING_CHAR_AND_LENGTH (copy_bufptr + i, + nbytes - i, len); + inev.ie.kind = (SINGLE_BYTE_CHAR_P (c) + ? ASCII_KEYSTROKE_EVENT + : MULTIBYTE_CHAR_KEYSTROKE_EVENT); + inev.ie.code = c; + kbd_buffer_store_event_hold (&inev.ie, hold_quit); } /* Previous code updated count by nchars rather than nbytes, @@ -7997,11 +8215,16 @@ x_new_font (f, fontname) register char *fontname; { struct font_info *fontp - = FS_LOAD_FONT (f, 0, fontname, -1); + = FS_LOAD_FONT (f, fontname); if (!fontp) return Qnil; + if (FRAME_FONT (f) == (XFontStruct *) (fontp->font)) + /* This font is already set in frame F. There's nothing more to + do. */ + return build_string (fontp->full_name); + FRAME_FONT (f) = (XFontStruct *) (fontp->font); FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset; FRAME_FONTSET (f) = -1; @@ -8045,33 +8268,45 @@ x_new_font (f, fontname) return build_string (fontp->full_name); } -/* Give frame F the fontset named FONTSETNAME as its default font, and - return the full name of that fontset. FONTSETNAME may be a wildcard - pattern; in that case, we choose some fontset that fits the pattern. - The return value shows which fontset we chose. */ +/* Give frame F the fontset named FONTSETNAME as its default fontset, + and return the full name of that fontset. FONTSETNAME may be a + wildcard pattern; in that case, we choose some fontset that fits + the pattern. FONTSETNAME may be a font name for ASCII characters; + in that case, we create a fontset from that font name. + + The return value shows which fontset we chose. + If FONTSETNAME specifies the default fontset, return Qt. + If an ASCII font in the specified fontset can't be loaded, return + Qnil. */ Lisp_Object x_new_fontset (f, fontsetname) struct frame *f; - char *fontsetname; + Lisp_Object fontsetname; { - int fontset = fs_query_fontset (build_string (fontsetname), 0); + int fontset = fs_query_fontset (fontsetname, 0); Lisp_Object result; - if (fontset < 0) - return Qnil; - - if (FRAME_FONTSET (f) == fontset) + if (fontset > 0 && f->output_data.x->fontset == fontset) /* This fontset is already set in frame F. There's nothing more to do. */ return fontset_name (fontset); + else if (fontset == 0) + /* The default fontset can't be the default font. */ + return Qt; - result = x_new_font (f, (SDATA (fontset_ascii (fontset)))); + if (fontset > 0) + result = x_new_font (f, (SDATA (fontset_ascii (fontset)))); + else + result = x_new_font (f, SDATA (fontsetname)); if (!STRINGP (result)) /* Can't load ASCII font. */ return Qnil; + if (fontset < 0) + fontset = new_fontset_from_font_name (result); + /* Since x_new_font doesn't update any fontset information, do it now. */ FRAME_FONTSET (f) = fontset; @@ -8081,9 +8316,71 @@ x_new_fontset (f, fontsetname) xic_set_xfontset (f, SDATA (fontset_ascii (fontset))); #endif - return build_string (fontsetname); + return fontset_name (fontset); } +#ifdef USE_FONT_BACKEND +Lisp_Object +x_new_fontset2 (f, fontset, font_object) + struct frame *f; + int fontset; + Lisp_Object font_object; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + + if (FRAME_FONT_OBJECT (f) == font) + /* This font is already set in frame F. There's nothing more to + do. */ + return fontset_name (fontset); + + BLOCK_INPUT; + + FRAME_FONT_OBJECT (f) = font; + FRAME_FONT (f) = font->font.font; + FRAME_BASELINE_OFFSET (f) = font->font.baseline_offset; + FRAME_FONTSET (f) = fontset; + + FRAME_COLUMN_WIDTH (f) = font->font.average_width; + FRAME_SPACE_WIDTH (f) = font->font.space_width; + FRAME_LINE_HEIGHT (f) = font->font.height; + + compute_fringe_widths (f, 1); + + /* Compute the scroll bar width in character columns. */ + if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0) + { + int wid = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_COLS (f) + = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + wid - 1) / wid; + } + else + { + int wid = FRAME_COLUMN_WIDTH (f); + FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid; + } + + /* Now make the frame display the given font. */ + if (FRAME_X_WINDOW (f) != 0) + { + /* Don't change the size of a tip frame; there's no point in + doing it because it's done in Fx_show_tip, and it leads to + problems because the tip frame has no widget. */ + if (NILP (tip_frame) || XFRAME (tip_frame) != f) + x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f)); + } + +#ifdef HAVE_X_I18N + if (FRAME_XIC (f) + && (FRAME_XIC_STYLE (f) & (XIMPreeditPosition | XIMStatusArea))) + xic_set_xfontset (f, SDATA (fontset_ascii (fontset))); +#endif + + UNBLOCK_INPUT; + + return fontset_name (fontset); +} +#endif /* USE_FONT_BACKEND */ + /*********************************************************************** X Input Methods @@ -9353,6 +9650,15 @@ x_free_frame_resources (f) commands to the X server. */ if (dpyinfo->display) { +#ifdef USE_FONT_BACKEND + /* We must free faces before destroying windows because some + font-driver (e.g. xft) access a window while finishing a + face. */ + if (enable_font_backend + && FRAME_FACE_CACHE (f)) + free_frame_faces (f); +#endif /* USE_FONT_BACKEND */ + if (f->output_data.x->icon_desc) XDestroyWindow (FRAME_X_DISPLAY (f), f->output_data.x->icon_desc); @@ -9734,7 +10040,7 @@ x_get_font_info (f, font_idx) If SIZE is > 0, it is the size (maximum bounds width) of fonts to be listed. - SIZE < 0 means include scalable fonts. + SIZE < 0 means include auto scaled fonts. Frame F null means we have not yet created any frame on X, and consult the first display in x_display_list. MAXNAMES sets a limit @@ -10043,6 +10349,11 @@ x_check_font (f, font) xassert (font != NULL); +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + /* Fixme: Perhaps we should check all cached fonts. */ + return; +#endif for (i = 0; i < dpyinfo->n_fonts; i++) if (dpyinfo->font_table[i].name && font == dpyinfo->font_table[i].font) @@ -10207,6 +10518,7 @@ x_load_font (f, fontname, size) bzero (fontp, sizeof (*fontp)); fontp->font = font; fontp->font_idx = i; + fontp->charset = -1; /* fs_load_font sets it. */ fontp->name = (char *) xmalloc (strlen (fontname) + 1); bcopy (fontname, fontp->name, strlen (fontname) + 1); @@ -10318,10 +10630,10 @@ x_load_font (f, fontname, size) the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or (0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF, 2:0xA020..0xFF7F). For the moment, we don't know which charset - uses this font. So, we set information in fontp->encoding[1] + uses this font. So, we set information in fontp->encoding_type which is never used by any charset. If mapping can't be decided, set FONT_ENCODING_NOT_DECIDED. */ - fontp->encoding[1] + fontp->encoding_type = (font->max_byte1 == 0 /* 1-byte font */ ? (font->min_char_or_byte2 < 0x80 @@ -10421,6 +10733,160 @@ x_find_ccl_program (fontp) } +/* Return a char-table whose elements are t if the font FONT_INFO + contains a glyph for the corresponding character, and nil if + not. */ + +Lisp_Object +x_get_font_repertory (f, font_info) + FRAME_PTR f; + struct font_info *font_info; +{ + XFontStruct *font = (XFontStruct *) font_info->font; + Lisp_Object table; + int min_byte1, max_byte1, min_byte2, max_byte2; + int c; + struct charset *charset = CHARSET_FROM_ID (font_info->charset); + int offset = CHARSET_OFFSET (charset); + + table = Fmake_char_table (Qnil, Qnil); + + min_byte1 = font->min_byte1; + max_byte1 = font->max_byte1; + min_byte2 = font->min_char_or_byte2; + max_byte2 = font->max_char_or_byte2; + if (min_byte1 == 0 && max_byte1 == 0) + { + if (! font->per_char || font->all_chars_exist == True) + { + if (offset >= 0) + char_table_set_range (table, offset + min_byte2, + offset + max_byte2, Qt); + else + for (; min_byte2 <= max_byte2; min_byte2++) + { + c = DECODE_CHAR (charset, min_byte2); + CHAR_TABLE_SET (table, c, Qt); + } + } + else + { + XCharStruct *pcm = font->per_char; + int from = -1; + int i; + + for (i = min_byte2; i <= max_byte2; i++, pcm++) + { + if (pcm->width == 0 && pcm->rbearing == pcm->lbearing) + { + if (from >= 0) + { + if (offset >= 0) + char_table_set_range (table, offset + from, + offset + i - 1, Qt); + else + for (; from < i; from++) + { + c = DECODE_CHAR (charset, from); + CHAR_TABLE_SET (table, c, Qt); + } + from = -1; + } + } + else if (from < 0) + from = i; + } + if (from >= 0) + { + if (offset >= 0) + char_table_set_range (table, offset + from, offset + i - 1, + Qt); + else + for (; from < i; from++) + { + c = DECODE_CHAR (charset, from); + CHAR_TABLE_SET (table, c, Qt); + } + } + } + } + else + { + if (! font->per_char || font->all_chars_exist == True) + { + int i, j; + + if (offset >= 0) + for (i = min_byte1; i <= max_byte1; i++) + char_table_set_range + (table, offset + ((i << 8) | min_byte2), + offset + ((i << 8) | max_byte2), Qt); + else + for (i = min_byte1; i <= max_byte1; i++) + for (j = min_byte2; j <= max_byte2; j++) + { + unsigned code = (i << 8) | j; + c = DECODE_CHAR (charset, code); + CHAR_TABLE_SET (table, c, Qt); + } + } + else + { + XCharStruct *pcm = font->per_char; + int i; + + for (i = min_byte1; i <= max_byte1; i++) + { + int from = -1; + int j; + + for (j = min_byte2; j <= max_byte2; j++, pcm++) + { + if (pcm->width == 0 && pcm->rbearing == pcm->lbearing) + { + if (from >= 0) + { + if (offset >= 0) + char_table_set_range + (table, offset + ((i << 8) | from), + offset + ((i << 8) | (j - 1)), Qt); + else + { + for (; from < j; from++) + { + unsigned code = (i << 8) | from; + c = ENCODE_CHAR (charset, code); + CHAR_TABLE_SET (table, c, Qt); + } + } + from = -1; + } + } + else if (from < 0) + from = j; + } + if (from >= 0) + { + if (offset >= 0) + char_table_set_range + (table, offset + ((i << 8) | from), + offset + ((i << 8) | (j - 1)), Qt); + else + { + for (; from < j; from++) + { + unsigned code = (i << 8) | from; + c = DECODE_CHAR (charset, code); + CHAR_TABLE_SET (table, c, Qt); + } + } + } + } + } + } + + return table; +} /*********************************************************************** Initialization @@ -11131,6 +11597,10 @@ x_delete_display (dpyinfo) xim_close_dpy (dpyinfo); #endif +#ifdef USE_FONT_BACKEND + if (! enable_font_backend) + { +#endif /* Free the font names in the font table. */ for (i = 0; i < dpyinfo->n_fonts; i++) if (dpyinfo->font_table[i].name) @@ -11146,6 +11616,10 @@ x_delete_display (dpyinfo) xfree (dpyinfo->font_table->font_encoder); xfree (dpyinfo->font_table); } +#ifdef USE_FONT_BACKEND + } +#endif + if (dpyinfo->x_id_name) xfree (dpyinfo->x_id_name); if (dpyinfo->color_cells) @@ -11255,6 +11729,9 @@ x_delete_terminal (struct terminal *terminal) return; BLOCK_INPUT; +#ifdef USE_FONT_BACKEND + if (! enable_font_backend) +#endif /* Free the fonts in the font table. */ for (i = 0; i < dpyinfo->n_fonts; i++) if (dpyinfo->font_table[i].name) @@ -11402,8 +11879,6 @@ syms_of_xterm () staticpro (&Qvendor_specific_keysyms); Qvendor_specific_keysyms = intern ("vendor-specific-keysyms"); - staticpro (&Qutf_8); - Qutf_8 = intern ("utf-8"); staticpro (&Qlatin_1); Qlatin_1 = intern ("latin-1"); diff --git a/src/xterm.h b/src/xterm.h index d9b5c327858..25b04fe75fa 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -405,6 +405,9 @@ extern struct font_info *x_get_font_info P_ ((struct frame *f, int)); extern struct font_info *x_load_font P_ ((struct frame *, char *, int)); extern struct font_info *x_query_font P_ ((struct frame *, char *)); extern void x_find_ccl_program P_ ((struct font_info *)); +extern Lisp_Object x_get_font_repertory P_ ((struct frame *, + struct font_info *)); + /* Each X frame object points to its own struct x_output object in the output_data.x field. The x_output structure contains @@ -486,6 +489,10 @@ struct x_output /* Default ASCII font of this frame. */ XFontStruct *font; +#ifdef USE_FONT_BACKEND + struct font *fontp; +#endif /* USE_FONT_BACKEND */ + /* The baseline offset of the default ASCII font. */ int baseline_offset; @@ -673,6 +680,10 @@ enum #define FRAME_TOOLBAR_HEIGHT(f) ((f)->output_data.x->toolbar_height) #define FRAME_BASELINE_OFFSET(f) ((f)->output_data.x->baseline_offset) +#ifdef USE_FONT_BACKEND +#define FRAME_FONT_OBJECT(f) ((f)->output_data.x->fontp) +#endif /* USE_FONT_BACKEND */ + /* This gives the x_display_info structure for the display F is on. */ #define FRAME_X_DISPLAY_INFO(f) ((f)->output_data.x->display_info) |