Mercurial > hg > xemacs-beta
annotate src/faces.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 26 Jan 2010 23:22:30 -0600 |
| parents | 7ac51121843b |
| children | 304aebb79cd3 |
| rev | line source |
|---|---|
| 428 | 1 /* "Face" primitives |
| 2 Copyright (C) 1994 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 793 | 4 Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. |
| 428 | 5 Copyright (C) 1995 Sun Microsystems, Inc. |
| 6 | |
| 7 This file is part of XEmacs. | |
| 8 | |
| 9 XEmacs is free software; you can redistribute it and/or modify it | |
| 10 under the terms of the GNU General Public License as published by the | |
| 11 Free Software Foundation; either version 2, or (at your option) any | |
| 12 later version. | |
| 13 | |
| 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 17 for more details. | |
| 18 | |
| 19 You should have received a copy of the GNU General Public License | |
| 20 along with XEmacs; see the file COPYING. If not, write to | |
| 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 Boston, MA 02111-1307, USA. */ | |
| 23 | |
| 24 /* Synched up with: Not in FSF. */ | |
| 25 | |
| 26 /* Written by Chuck Thompson and Ben Wing, | |
| 27 based loosely on old face code by Jamie Zawinski. */ | |
| 28 | |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 31 | |
| 32 #include "buffer.h" | |
| 872 | 33 #include "device-impl.h" |
| 428 | 34 #include "elhash.h" |
| 872 | 35 #include "extents-impl.h" /* for extent_face */ |
| 428 | 36 #include "faces.h" |
| 872 | 37 #include "frame-impl.h" |
| 428 | 38 #include "glyphs.h" |
| 872 | 39 #include "objects-impl.h" |
| 428 | 40 #include "specifier.h" |
| 41 #include "window.h" | |
| 42 | |
| 43 Lisp_Object Qfacep; | |
| 44 Lisp_Object Qforeground, Qbackground, Qdisplay_table; | |
| 45 Lisp_Object Qbackground_pixmap, Qunderline, Qdim; | |
| 46 Lisp_Object Qblinking, Qstrikethru; | |
| 47 | |
| 48 Lisp_Object Qinit_face_from_resources; | |
| 49 Lisp_Object Qinit_frame_faces; | |
| 50 Lisp_Object Qinit_device_faces; | |
| 51 Lisp_Object Qinit_global_faces; | |
| 52 | |
| 53 /* These faces are used directly internally. We use these variables | |
| 54 to be able to reference them directly and save the overhead of | |
| 55 calling Ffind_face. */ | |
| 56 Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face; | |
| 57 Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face; | |
| 58 Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face; | |
| 59 | |
| 440 | 60 /* Qdefault, Qhighlight, Qleft_margin, Qright_margin defined in general.c */ |
| 61 Lisp_Object Qmodeline, Qgui_element, Qtext_cursor, Qvertical_divider; | |
| 428 | 62 |
| 2867 | 63 Lisp_Object Qface_alias, Qcyclic_face_alias; |
| 2865 | 64 |
| 428 | 65 /* In the old implementation Vface_list was a list of the face names, |
| 66 not the faces themselves. We now distinguish between permanent and | |
| 67 temporary faces. Permanent faces are kept in a regular hash table, | |
| 68 temporary faces in a weak hash table. */ | |
| 69 Lisp_Object Vpermanent_faces_cache; | |
| 70 Lisp_Object Vtemporary_faces_cache; | |
| 71 | |
| 72 Lisp_Object Vbuilt_in_face_specifiers; | |
| 73 | |
| 74 | |
| 3659 | 75 #ifdef DEBUG_XEMACS |
| 76 Fixnum debug_x_faces; | |
| 77 #endif | |
| 78 | |
| 4187 | 79 #if defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901) |
| 3659 | 80 |
| 81 #ifdef DEBUG_XEMACS | |
| 82 # define DEBUG_FACES(FORMAT, ...) \ | |
| 83 do { if (debug_x_faces) stderr_out(FORMAT, __VA_ARGS__); } while (0) | |
| 84 #else /* DEBUG_XEMACS */ | |
| 85 # define DEBUG_FACES(format, ...) | |
| 86 #endif /* DEBUG_XEMACS */ | |
| 87 | |
| 88 #elif defined(__GNUC__) | |
| 89 | |
| 90 #ifdef DEBUG_XEMACS | |
| 91 # define DEBUG_FACES(format, args...) \ | |
| 92 do { if (debug_x_faces) stderr_out(format, args ); } while (0) | |
| 93 #else /* DEBUG_XEMACS */ | |
| 94 # define DEBUG_FACES(format, args...) | |
| 95 #endif /* DEBUG_XEMACS */ | |
| 96 | |
| 97 #else /* defined(__STDC_VERSION__) [...] */ | |
| 98 # define DEBUG_FACES (void) | |
| 99 #endif | |
| 428 | 100 |
| 101 static Lisp_Object | |
| 102 mark_face (Lisp_Object obj) | |
| 103 { | |
| 440 | 104 Lisp_Face *face = XFACE (obj); |
| 428 | 105 |
| 106 mark_object (face->name); | |
| 107 mark_object (face->doc_string); | |
| 108 | |
| 109 mark_object (face->foreground); | |
| 110 mark_object (face->background); | |
| 111 mark_object (face->font); | |
| 112 mark_object (face->display_table); | |
| 113 mark_object (face->background_pixmap); | |
| 114 mark_object (face->underline); | |
| 115 mark_object (face->strikethru); | |
| 116 mark_object (face->highlight); | |
| 117 mark_object (face->dim); | |
| 118 mark_object (face->blinking); | |
| 119 mark_object (face->reverse); | |
| 120 | |
| 121 mark_object (face->charsets_warned_about); | |
| 122 | |
| 123 return face->plist; | |
| 124 } | |
| 125 | |
| 126 static void | |
| 2286 | 127 print_face (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) |
| 428 | 128 { |
| 440 | 129 Lisp_Face *face = XFACE (obj); |
| 428 | 130 |
| 131 if (print_readably) | |
| 132 { | |
| 800 | 133 write_fmt_string_lisp (printcharfun, "#s(face name %S)", 1, face->name); |
| 428 | 134 } |
| 135 else | |
| 136 { | |
| 800 | 137 write_fmt_string_lisp (printcharfun, "#<face %S", 1, face->name); |
| 428 | 138 if (!NILP (face->doc_string)) |
| 800 | 139 write_fmt_string_lisp (printcharfun, " %S", 1, face->doc_string); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
140 write_ascstring (printcharfun, ">"); |
| 428 | 141 } |
| 142 } | |
| 143 | |
| 144 /* Faces are equal if all of their display attributes are equal. We | |
| 145 don't compare names or doc-strings, because that would make equal | |
| 146 be eq. | |
| 147 | |
| 148 This isn't concerned with "unspecified" attributes, that's what | |
| 149 #'face-differs-from-default-p is for. */ | |
| 150 static int | |
| 151 face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
| 152 { | |
| 440 | 153 Lisp_Face *f1 = XFACE (obj1); |
| 154 Lisp_Face *f2 = XFACE (obj2); | |
| 428 | 155 |
| 156 depth++; | |
| 157 | |
| 158 return | |
| 159 (internal_equal (f1->foreground, f2->foreground, depth) && | |
| 160 internal_equal (f1->background, f2->background, depth) && | |
| 161 internal_equal (f1->font, f2->font, depth) && | |
| 162 internal_equal (f1->display_table, f2->display_table, depth) && | |
| 163 internal_equal (f1->background_pixmap, f2->background_pixmap, depth) && | |
| 164 internal_equal (f1->underline, f2->underline, depth) && | |
| 165 internal_equal (f1->strikethru, f2->strikethru, depth) && | |
| 166 internal_equal (f1->highlight, f2->highlight, depth) && | |
| 167 internal_equal (f1->dim, f2->dim, depth) && | |
| 168 internal_equal (f1->blinking, f2->blinking, depth) && | |
| 169 internal_equal (f1->reverse, f2->reverse, depth) && | |
| 170 | |
| 171 ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1)); | |
| 172 } | |
| 173 | |
| 665 | 174 static Hashcode |
| 428 | 175 face_hash (Lisp_Object obj, int depth) |
| 176 { | |
| 440 | 177 Lisp_Face *f = XFACE (obj); |
| 428 | 178 |
| 179 depth++; | |
| 180 | |
| 181 /* No need to hash all of the elements; that would take too long. | |
| 182 Just hash the most common ones. */ | |
| 183 return HASH3 (internal_hash (f->foreground, depth), | |
| 184 internal_hash (f->background, depth), | |
| 185 internal_hash (f->font, depth)); | |
| 186 } | |
| 187 | |
| 188 static Lisp_Object | |
| 189 face_getprop (Lisp_Object obj, Lisp_Object prop) | |
| 190 { | |
| 440 | 191 Lisp_Face *f = XFACE (obj); |
| 428 | 192 |
| 193 return | |
| 194 (EQ (prop, Qforeground) ? f->foreground : | |
| 195 EQ (prop, Qbackground) ? f->background : | |
| 196 EQ (prop, Qfont) ? f->font : | |
| 197 EQ (prop, Qdisplay_table) ? f->display_table : | |
| 198 EQ (prop, Qbackground_pixmap) ? f->background_pixmap : | |
| 199 EQ (prop, Qunderline) ? f->underline : | |
| 200 EQ (prop, Qstrikethru) ? f->strikethru : | |
| 201 EQ (prop, Qhighlight) ? f->highlight : | |
| 202 EQ (prop, Qdim) ? f->dim : | |
| 203 EQ (prop, Qblinking) ? f->blinking : | |
| 204 EQ (prop, Qreverse) ? f->reverse : | |
| 205 EQ (prop, Qdoc_string) ? f->doc_string : | |
| 206 external_plist_get (&f->plist, prop, 0, ERROR_ME)); | |
| 207 } | |
| 208 | |
| 209 static int | |
| 210 face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) | |
| 211 { | |
| 440 | 212 Lisp_Face *f = XFACE (obj); |
| 428 | 213 |
| 214 if (EQ (prop, Qforeground) || | |
| 215 EQ (prop, Qbackground) || | |
| 216 EQ (prop, Qfont) || | |
| 217 EQ (prop, Qdisplay_table) || | |
| 218 EQ (prop, Qbackground_pixmap) || | |
| 219 EQ (prop, Qunderline) || | |
| 220 EQ (prop, Qstrikethru) || | |
| 221 EQ (prop, Qhighlight) || | |
| 222 EQ (prop, Qdim) || | |
| 223 EQ (prop, Qblinking) || | |
| 224 EQ (prop, Qreverse)) | |
| 225 return 0; | |
| 226 | |
| 227 if (EQ (prop, Qdoc_string)) | |
| 228 { | |
| 229 if (!NILP (value)) | |
| 230 CHECK_STRING (value); | |
| 231 f->doc_string = value; | |
| 232 return 1; | |
| 233 } | |
| 234 | |
| 235 external_plist_put (&f->plist, prop, value, 0, ERROR_ME); | |
| 236 return 1; | |
| 237 } | |
| 238 | |
| 239 static int | |
| 240 face_remprop (Lisp_Object obj, Lisp_Object prop) | |
| 241 { | |
| 440 | 242 Lisp_Face *f = XFACE (obj); |
| 428 | 243 |
| 244 if (EQ (prop, Qforeground) || | |
| 245 EQ (prop, Qbackground) || | |
| 246 EQ (prop, Qfont) || | |
| 247 EQ (prop, Qdisplay_table) || | |
| 248 EQ (prop, Qbackground_pixmap) || | |
| 249 EQ (prop, Qunderline) || | |
| 250 EQ (prop, Qstrikethru) || | |
| 251 EQ (prop, Qhighlight) || | |
| 252 EQ (prop, Qdim) || | |
| 253 EQ (prop, Qblinking) || | |
| 254 EQ (prop, Qreverse)) | |
| 255 return -1; | |
| 256 | |
| 257 if (EQ (prop, Qdoc_string)) | |
| 258 { | |
| 259 f->doc_string = Qnil; | |
| 260 return 1; | |
| 261 } | |
| 262 | |
| 263 return external_remprop (&f->plist, prop, 0, ERROR_ME); | |
| 264 } | |
| 265 | |
| 266 static Lisp_Object | |
| 267 face_plist (Lisp_Object obj) | |
| 268 { | |
| 440 | 269 Lisp_Face *face = XFACE (obj); |
| 428 | 270 Lisp_Object result = face->plist; |
| 271 | |
| 272 result = cons3 (Qreverse, face->reverse, result); | |
| 273 result = cons3 (Qblinking, face->blinking, result); | |
| 274 result = cons3 (Qdim, face->dim, result); | |
| 275 result = cons3 (Qhighlight, face->highlight, result); | |
| 276 result = cons3 (Qstrikethru, face->strikethru, result); | |
| 277 result = cons3 (Qunderline, face->underline, result); | |
| 278 result = cons3 (Qbackground_pixmap, face->background_pixmap, result); | |
| 279 result = cons3 (Qdisplay_table, face->display_table, result); | |
| 280 result = cons3 (Qfont, face->font, result); | |
| 281 result = cons3 (Qbackground, face->background, result); | |
| 282 result = cons3 (Qforeground, face->foreground, result); | |
| 283 | |
| 284 return result; | |
| 285 } | |
| 286 | |
| 1204 | 287 static const struct memory_description face_description[] = { |
| 440 | 288 { XD_LISP_OBJECT, offsetof (Lisp_Face, name) }, |
| 289 { XD_LISP_OBJECT, offsetof (Lisp_Face, doc_string) }, | |
| 290 { XD_LISP_OBJECT, offsetof (Lisp_Face, foreground) }, | |
| 291 { XD_LISP_OBJECT, offsetof (Lisp_Face, background) }, | |
| 292 { XD_LISP_OBJECT, offsetof (Lisp_Face, font) }, | |
| 293 { XD_LISP_OBJECT, offsetof (Lisp_Face, display_table) }, | |
| 294 { XD_LISP_OBJECT, offsetof (Lisp_Face, background_pixmap) }, | |
| 295 { XD_LISP_OBJECT, offsetof (Lisp_Face, underline) }, | |
| 296 { XD_LISP_OBJECT, offsetof (Lisp_Face, strikethru) }, | |
| 297 { XD_LISP_OBJECT, offsetof (Lisp_Face, highlight) }, | |
| 298 { XD_LISP_OBJECT, offsetof (Lisp_Face, dim) }, | |
| 299 { XD_LISP_OBJECT, offsetof (Lisp_Face, blinking) }, | |
| 300 { XD_LISP_OBJECT, offsetof (Lisp_Face, reverse) }, | |
| 301 { XD_LISP_OBJECT, offsetof (Lisp_Face, plist) }, | |
| 302 { XD_LISP_OBJECT, offsetof (Lisp_Face, charsets_warned_about) }, | |
| 428 | 303 { XD_END } |
| 304 }; | |
| 305 | |
| 934 | 306 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face, |
| 307 1, /*dumpable-flag*/ | |
| 308 mark_face, print_face, 0, face_equal, | |
| 1204 | 309 face_hash, face_description, |
| 310 face_getprop, | |
| 934 | 311 face_putprop, face_remprop, |
| 312 face_plist, Lisp_Face); | |
| 428 | 313 |
| 314 /************************************************************************/ | |
| 315 /* face read syntax */ | |
| 316 /************************************************************************/ | |
| 317 | |
| 318 static int | |
| 2286 | 319 face_name_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 578 | 320 Error_Behavior errb) |
| 428 | 321 { |
| 322 if (ERRB_EQ (errb, ERROR_ME)) | |
| 323 { | |
| 324 CHECK_SYMBOL (value); | |
| 325 return 1; | |
| 326 } | |
| 327 | |
| 328 return SYMBOLP (value); | |
| 329 } | |
| 330 | |
| 331 static int | |
| 578 | 332 face_validate (Lisp_Object data, Error_Behavior errb) |
| 428 | 333 { |
| 334 int name_seen = 0; | |
| 335 Lisp_Object valw = Qnil; | |
| 336 | |
| 337 data = Fcdr (data); /* skip over Qface */ | |
| 338 while (!NILP (data)) | |
| 339 { | |
| 340 Lisp_Object keyw = Fcar (data); | |
| 341 | |
| 342 data = Fcdr (data); | |
| 343 valw = Fcar (data); | |
| 344 data = Fcdr (data); | |
| 345 if (EQ (keyw, Qname)) | |
| 346 name_seen = 1; | |
| 347 else | |
| 2500 | 348 ABORT (); |
| 428 | 349 } |
| 350 | |
| 351 if (!name_seen) | |
| 352 { | |
| 563 | 353 maybe_sferror ("No face name given", Qunbound, Qface, errb); |
| 428 | 354 return 0; |
| 355 } | |
| 356 | |
| 357 if (NILP (Ffind_face (valw))) | |
| 358 { | |
| 563 | 359 maybe_invalid_argument ("No such face", valw, Qface, errb); |
| 428 | 360 return 0; |
| 361 } | |
| 362 | |
| 363 return 1; | |
| 364 } | |
| 365 | |
| 366 static Lisp_Object | |
| 367 face_instantiate (Lisp_Object data) | |
| 368 { | |
| 369 return Fget_face (Fcar (Fcdr (data))); | |
| 370 } | |
| 371 | |
| 372 | |
| 373 /**************************************************************************** | |
| 374 * utility functions * | |
| 375 ****************************************************************************/ | |
| 376 | |
| 377 static void | |
| 440 | 378 reset_face (Lisp_Face *f) |
| 428 | 379 { |
| 380 f->name = Qnil; | |
| 381 f->doc_string = Qnil; | |
| 382 f->dirty = 0; | |
| 383 f->foreground = Qnil; | |
| 384 f->background = Qnil; | |
| 385 f->font = Qnil; | |
| 386 f->display_table = Qnil; | |
| 387 f->background_pixmap = Qnil; | |
| 388 f->underline = Qnil; | |
| 389 f->strikethru = Qnil; | |
| 390 f->highlight = Qnil; | |
| 391 f->dim = Qnil; | |
| 392 f->blinking = Qnil; | |
| 393 f->reverse = Qnil; | |
| 394 f->plist = Qnil; | |
| 395 f->charsets_warned_about = Qnil; | |
| 396 } | |
| 397 | |
| 440 | 398 static Lisp_Face * |
| 428 | 399 allocate_face (void) |
| 400 { | |
| 3017 | 401 Lisp_Face *result = ALLOC_LCRECORD_TYPE (Lisp_Face, &lrecord_face); |
| 428 | 402 |
| 403 reset_face (result); | |
| 404 return result; | |
| 405 } | |
| 406 | |
| 407 | |
| 408 /* We store the faces in hash tables with the names as the key and the | |
| 409 actual face object as the value. Occasionally we need to use them | |
| 410 in a list format. These routines provide us with that. */ | |
| 411 struct face_list_closure | |
| 412 { | |
| 413 Lisp_Object *face_list; | |
| 414 }; | |
| 415 | |
| 416 static int | |
| 2286 | 417 add_face_to_list_mapper (Lisp_Object UNUSED (key), Lisp_Object value, |
| 428 | 418 void *face_list_closure) |
| 419 { | |
| 420 /* This function can GC */ | |
| 421 struct face_list_closure *fcl = | |
| 422 (struct face_list_closure *) face_list_closure; | |
| 423 | |
| 424 *(fcl->face_list) = Fcons (XFACE (value)->name, (*fcl->face_list)); | |
| 425 return 0; | |
| 426 } | |
| 427 | |
| 428 static Lisp_Object | |
| 429 faces_list_internal (Lisp_Object list) | |
| 430 { | |
| 431 Lisp_Object face_list = Qnil; | |
| 432 struct gcpro gcpro1; | |
| 433 struct face_list_closure face_list_closure; | |
| 434 | |
| 435 GCPRO1 (face_list); | |
| 436 face_list_closure.face_list = &face_list; | |
| 437 elisp_maphash (add_face_to_list_mapper, list, &face_list_closure); | |
| 438 UNGCPRO; | |
| 439 | |
| 440 return face_list; | |
| 441 } | |
| 442 | |
| 443 static Lisp_Object | |
| 444 permanent_faces_list (void) | |
| 445 { | |
| 446 return faces_list_internal (Vpermanent_faces_cache); | |
| 447 } | |
| 448 | |
| 449 static Lisp_Object | |
| 450 temporary_faces_list (void) | |
| 451 { | |
| 452 return faces_list_internal (Vtemporary_faces_cache); | |
| 453 } | |
| 454 | |
| 455 | |
| 456 static int | |
| 2286 | 457 mark_face_as_clean_mapper (Lisp_Object UNUSED (key), Lisp_Object value, |
| 428 | 458 void *flag_closure) |
| 459 { | |
| 460 /* This function can GC */ | |
| 461 int *flag = (int *) flag_closure; | |
| 462 XFACE (value)->dirty = *flag; | |
| 463 return 0; | |
| 464 } | |
| 465 | |
| 466 static void | |
| 467 mark_all_faces_internal (int flag) | |
| 468 { | |
| 469 elisp_maphash (mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag); | |
| 470 elisp_maphash (mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag); | |
| 471 } | |
| 472 | |
| 473 void | |
| 474 mark_all_faces_as_clean (void) | |
| 475 { | |
| 476 mark_all_faces_internal (0); | |
| 477 } | |
| 478 | |
| 479 /* Currently unused (see the comment in face_property_was_changed()). */ | |
| 480 #if 0 | |
| 481 /* #### OBSOLETE ME, PLEASE. Maybe. Maybe this is just as good as | |
| 482 any other solution. */ | |
| 483 struct face_inheritance_closure | |
| 484 { | |
| 485 Lisp_Object face; | |
| 486 Lisp_Object property; | |
| 487 }; | |
| 488 | |
| 489 static void | |
| 490 update_inheritance_mapper_internal (Lisp_Object cur_face, | |
| 491 Lisp_Object inh_face, | |
| 492 Lisp_Object property) | |
| 493 { | |
| 494 /* #### fix this function */ | |
| 495 Lisp_Object elt = Qnil; | |
| 496 struct gcpro gcpro1; | |
| 497 | |
| 498 GCPRO1 (elt); | |
| 499 | |
| 500 for (elt = FACE_PROPERTY_SPEC_LIST (cur_face, property, Qall); | |
| 501 !NILP (elt); | |
| 502 elt = XCDR (elt)) | |
| 503 { | |
| 504 Lisp_Object values = XCDR (XCAR (elt)); | |
| 505 | |
| 506 for (; !NILP (values); values = XCDR (values)) | |
| 507 { | |
| 508 Lisp_Object value = XCDR (XCAR (values)); | |
| 509 if (VECTORP (value) && XVECTOR_LENGTH (value)) | |
| 510 { | |
| 511 if (EQ (Ffind_face (XVECTOR_DATA (value)[0]), inh_face)) | |
| 512 Fset_specifier_dirty_flag | |
| 513 (FACE_PROPERTY_SPECIFIER (inh_face, property)); | |
| 514 } | |
| 515 } | |
| 516 } | |
| 517 | |
| 518 UNGCPRO; | |
| 519 } | |
| 520 | |
| 521 static int | |
| 442 | 522 update_face_inheritance_mapper (const void *hash_key, void *hash_contents, |
| 428 | 523 void *face_inheritance_closure) |
| 524 { | |
| 525 Lisp_Object key, contents; | |
| 526 struct face_inheritance_closure *fcl = | |
| 527 (struct face_inheritance_closure *) face_inheritance_closure; | |
| 528 | |
| 826 | 529 key = VOID_TO_LISP (hash_key); |
| 530 contents = VOID_TO_LISP (hash_contents); | |
| 428 | 531 |
| 532 if (EQ (fcl->property, Qfont)) | |
| 533 { | |
| 534 update_inheritance_mapper_internal (contents, fcl->face, Qfont); | |
| 535 } | |
| 536 else if (EQ (fcl->property, Qforeground) || | |
| 537 EQ (fcl->property, Qbackground)) | |
| 538 { | |
| 539 update_inheritance_mapper_internal (contents, fcl->face, Qforeground); | |
| 540 update_inheritance_mapper_internal (contents, fcl->face, Qbackground); | |
| 541 } | |
| 542 else if (EQ (fcl->property, Qunderline) || | |
| 543 EQ (fcl->property, Qstrikethru) || | |
| 544 EQ (fcl->property, Qhighlight) || | |
| 545 EQ (fcl->property, Qdim) || | |
| 546 EQ (fcl->property, Qblinking) || | |
| 547 EQ (fcl->property, Qreverse)) | |
| 548 { | |
| 549 update_inheritance_mapper_internal (contents, fcl->face, Qunderline); | |
| 550 update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru); | |
| 551 update_inheritance_mapper_internal (contents, fcl->face, Qhighlight); | |
| 552 update_inheritance_mapper_internal (contents, fcl->face, Qdim); | |
| 553 update_inheritance_mapper_internal (contents, fcl->face, Qblinking); | |
| 554 update_inheritance_mapper_internal (contents, fcl->face, Qreverse); | |
| 555 } | |
| 556 return 0; | |
| 557 } | |
| 558 | |
| 559 static void | |
| 560 update_faces_inheritance (Lisp_Object face, Lisp_Object property) | |
| 561 { | |
| 562 struct face_inheritance_closure face_inheritance_closure; | |
| 563 struct gcpro gcpro1, gcpro2; | |
| 564 | |
| 565 GCPRO2 (face, property); | |
| 566 face_inheritance_closure.face = face; | |
| 567 face_inheritance_closure.property = property; | |
| 568 | |
| 569 elisp_maphash (update_face_inheritance_mapper, Vpermanent_faces_cache, | |
| 570 &face_inheritance_closure); | |
| 571 elisp_maphash (update_face_inheritance_mapper, Vtemporary_faces_cache, | |
| 572 &face_inheritance_closure); | |
| 573 | |
| 574 UNGCPRO; | |
| 575 } | |
| 576 #endif /* 0 */ | |
| 577 | |
| 578 Lisp_Object | |
| 579 face_property_matching_instance (Lisp_Object face, Lisp_Object property, | |
| 580 Lisp_Object charset, Lisp_Object domain, | |
| 578 | 581 Error_Behavior errb, int no_fallback, |
| 3659 | 582 Lisp_Object depth, |
| 583 enum font_specifier_matchspec_stages stage) | |
| 428 | 584 { |
| 771 | 585 Lisp_Object retval; |
| 872 | 586 Lisp_Object matchspec = Qunbound; |
| 587 struct gcpro gcpro1; | |
| 771 | 588 |
| 872 | 589 if (!NILP (charset)) |
| 4187 | 590 matchspec = noseeum_cons (charset, |
| 3659 | 591 stage == initial ? Qinitial : Qfinal); |
| 592 | |
| 872 | 593 GCPRO1 (matchspec); |
| 594 retval = specifier_instance_no_quit (Fget (face, property, Qnil), matchspec, | |
| 771 | 595 domain, errb, no_fallback, depth); |
| 872 | 596 UNGCPRO; |
| 597 if (CONSP (matchspec)) | |
| 598 free_cons (matchspec); | |
| 428 | 599 |
| 3659 | 600 if (UNBOUNDP (retval) && !no_fallback && final == stage) |
| 428 | 601 { |
| 602 if (EQ (property, Qfont)) | |
| 603 { | |
| 604 if (NILP (memq_no_quit (charset, | |
| 605 XFACE (face)->charsets_warned_about))) | |
| 606 { | |
| 793 | 607 if (!UNBOUNDP (charset)) |
| 428 | 608 warn_when_safe |
| 793 | 609 (Qfont, Qnotice, |
| 610 "Unable to instantiate font for charset %s, face %s", | |
| 611 XSTRING_DATA (symbol_name | |
| 612 (XSYMBOL (XCHARSET_NAME (charset)))), | |
| 613 XSTRING_DATA (symbol_name | |
| 614 (XSYMBOL (XFACE (face)->name)))); | |
| 428 | 615 XFACE (face)->charsets_warned_about = |
| 616 Fcons (charset, XFACE (face)->charsets_warned_about); | |
| 617 } | |
| 618 retval = Vthe_null_font_instance; | |
| 619 } | |
| 620 } | |
| 621 | |
| 622 return retval; | |
| 623 } | |
| 624 | |
| 625 | |
| 626 DEFUN ("facep", Ffacep, 1, 1, 0, /* | |
| 444 | 627 Return t if OBJECT is a face. |
| 428 | 628 */ |
| 629 (object)) | |
| 630 { | |
| 631 return FACEP (object) ? Qt : Qnil; | |
| 632 } | |
| 633 | |
| 634 DEFUN ("find-face", Ffind_face, 1, 1, 0, /* | |
| 635 Retrieve the face of the given name. | |
| 636 If FACE-OR-NAME is a face object, it is simply returned. | |
| 637 Otherwise, FACE-OR-NAME should be a symbol. If there is no such face, | |
| 638 nil is returned. Otherwise the associated face object is returned. | |
| 639 */ | |
| 640 (face_or_name)) | |
| 641 { | |
| 642 Lisp_Object retval; | |
| 2865 | 643 Lisp_Object face_name; |
| 644 Lisp_Object face_alias; | |
| 645 int i; | |
| 428 | 646 |
| 647 if (FACEP (face_or_name)) | |
| 648 return face_or_name; | |
| 2865 | 649 |
| 650 face_name = face_or_name; | |
| 651 CHECK_SYMBOL (face_name); | |
| 652 | |
| 2867 | 653 # define FACE_ALIAS_MAX_DEPTH 32 |
| 2865 | 654 |
| 655 i = 0; | |
| 656 while (! NILP ((face_alias = Fget (face_name, Qface_alias, Qnil))) | |
| 2867 | 657 && i < FACE_ALIAS_MAX_DEPTH) |
| 2865 | 658 { |
| 659 face_name = face_alias; | |
| 660 CHECK_SYMBOL (face_alias); | |
| 661 i += 1; | |
| 662 } | |
| 663 | |
| 664 /* #### This test actually makes the aliasing max depth to 30, which is more | |
| 665 #### than enough IMO. -- dvl */ | |
| 2867 | 666 if (i == FACE_ALIAS_MAX_DEPTH) |
| 667 signal_error (Qcyclic_face_alias, | |
| 2865 | 668 "Max face aliasing depth reached", |
| 669 face_name); | |
| 670 | |
| 2867 | 671 # undef FACE_ALIAS_MAX_DEPTH |
| 428 | 672 |
| 673 /* Check if the name represents a permanent face. */ | |
| 2865 | 674 retval = Fgethash (face_name, Vpermanent_faces_cache, Qnil); |
| 428 | 675 if (!NILP (retval)) |
| 676 return retval; | |
| 677 | |
| 678 /* Check if the name represents a temporary face. */ | |
| 2865 | 679 return Fgethash (face_name, Vtemporary_faces_cache, Qnil); |
| 428 | 680 } |
| 681 | |
| 682 DEFUN ("get-face", Fget_face, 1, 1, 0, /* | |
| 683 Retrieve the face of the given name. | |
| 684 Same as `find-face' except an error is signalled if there is no such | |
| 685 face instead of returning nil. | |
| 686 */ | |
| 687 (name)) | |
| 688 { | |
| 689 Lisp_Object face = Ffind_face (name); | |
| 690 | |
| 691 if (NILP (face)) | |
| 563 | 692 invalid_argument ("No such face", name); |
| 428 | 693 return face; |
| 694 } | |
| 695 | |
| 696 DEFUN ("face-name", Fface_name, 1, 1, 0, /* | |
| 697 Return the name of the given face. | |
| 698 */ | |
| 699 (face)) | |
| 700 { | |
| 701 return XFACE (Fget_face (face))->name; | |
| 702 } | |
| 703 | |
| 704 DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /* | |
| 705 Return a list of all built-in face specifier properties. | |
|
4534
f32c7f843961
#'built-in-face-specifiers; document that we're returning a copy.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4532
diff
changeset
|
706 |
|
f32c7f843961
#'built-in-face-specifiers; document that we're returning a copy.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4532
diff
changeset
|
707 This is a copy; there is no way to modify XEmacs' idea of the built-in face |
|
f32c7f843961
#'built-in-face-specifiers; document that we're returning a copy.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4532
diff
changeset
|
708 specifier properties from Lisp. |
| 428 | 709 */ |
| 710 ()) | |
| 711 { | |
|
4532
16906fefc8df
Return a list copy in #'built-in-face-specifiers, pre-empting modification.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4210
diff
changeset
|
712 return Fcopy_list(Vbuilt_in_face_specifiers); |
| 428 | 713 } |
| 714 | |
| 715 /* These values are retrieved so often that we make a special | |
| 716 function. | |
| 717 */ | |
| 718 | |
| 719 void | |
| 720 default_face_font_info (Lisp_Object domain, int *ascent, int *descent, | |
| 721 int *height, int *width, int *proportional_p) | |
| 722 { | |
| 723 Lisp_Object font_instance; | |
| 3707 | 724 struct face_cachel *cachel; |
| 725 struct window *w = NULL; | |
| 428 | 726 |
| 727 if (noninteractive) | |
| 728 { | |
| 729 if (ascent) | |
| 4187 | 730 *ascent = 1; |
| 428 | 731 if (descent) |
| 4187 | 732 *descent = 0; |
| 428 | 733 if (height) |
| 4187 | 734 *height = 1; |
| 428 | 735 if (width) |
| 4187 | 736 *width = 1; |
| 428 | 737 if (proportional_p) |
| 4187 | 738 *proportional_p = 0; |
| 428 | 739 return; |
| 740 } | |
| 741 | |
| 3707 | 742 /* We use ASCII here. This is reasonable because the people calling this |
| 743 function are using the resulting values to come up with overall sizes | |
| 4187 | 744 for windows and frames. |
| 3707 | 745 |
| 746 It's possible for this function to get called when the face cachels | |
| 747 have not been initialized--put a call to debug-print in | |
| 748 init-locale-at-early-startup to see it happen. */ | |
| 749 | |
| 750 if (WINDOWP (domain) && (w = XWINDOW (domain)) && w->face_cachels) | |
| 428 | 751 { |
| 752 if (!Dynarr_length (w->face_cachels)) | |
| 4187 | 753 reset_face_cachels (w); |
| 428 | 754 cachel = WINDOW_FACE_CACHEL (w, DEFAULT_INDEX); |
| 755 font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii); | |
| 756 } | |
| 757 else | |
| 758 { | |
| 759 font_instance = FACE_FONT (Vdefault_face, domain, Vcharset_ascii); | |
| 760 } | |
| 761 | |
| 3707 | 762 if (UNBOUNDP (font_instance)) |
| 763 { | |
| 764 return; | |
| 765 } | |
| 766 | |
| 428 | 767 if (height) |
| 768 *height = XFONT_INSTANCE (font_instance)->height; | |
| 769 if (width) | |
| 770 *width = XFONT_INSTANCE (font_instance)->width; | |
| 771 if (ascent) | |
| 772 *ascent = XFONT_INSTANCE (font_instance)->ascent; | |
| 773 if (descent) | |
| 774 *descent = XFONT_INSTANCE (font_instance)->descent; | |
| 775 if (proportional_p) | |
| 776 *proportional_p = XFONT_INSTANCE (font_instance)->proportional_p; | |
| 777 } | |
| 778 | |
| 779 void | |
| 780 default_face_height_and_width (Lisp_Object domain, | |
| 781 int *height, int *width) | |
| 782 { | |
| 783 default_face_font_info (domain, 0, 0, height, width, 0); | |
| 784 } | |
| 785 | |
| 786 void | |
| 787 default_face_height_and_width_1 (Lisp_Object domain, | |
| 788 int *height, int *width) | |
| 789 { | |
| 790 if (window_system_pixelated_geometry (domain)) | |
| 791 { | |
| 792 if (height) | |
| 793 *height = 1; | |
| 794 if (width) | |
| 795 *width = 1; | |
| 796 } | |
| 797 else | |
| 798 default_face_height_and_width (domain, height, width); | |
| 799 } | |
| 800 | |
| 801 DEFUN ("face-list", Fface_list, 0, 1, 0, /* | |
| 802 Return a list of the names of all defined faces. | |
| 803 If TEMPORARY is nil, only the permanent faces are included. | |
| 804 If it is t, only the temporary faces are included. If it is any | |
| 805 other non-nil value both permanent and temporary are included. | |
| 806 */ | |
| 807 (temporary)) | |
| 808 { | |
| 809 Lisp_Object face_list = Qnil; | |
| 810 | |
| 811 /* Added the permanent faces, if requested. */ | |
| 812 if (NILP (temporary) || !EQ (Qt, temporary)) | |
| 813 face_list = permanent_faces_list (); | |
| 814 | |
| 815 if (!NILP (temporary)) | |
| 816 { | |
| 817 struct gcpro gcpro1; | |
| 818 GCPRO1 (face_list); | |
| 819 face_list = nconc2 (face_list, temporary_faces_list ()); | |
| 820 UNGCPRO; | |
| 821 } | |
| 822 | |
| 823 return face_list; | |
| 824 } | |
| 825 | |
| 826 DEFUN ("make-face", Fmake_face, 1, 3, 0, /* | |
| 444 | 827 Define a new face with name NAME (a symbol), described by DOC-STRING. |
| 828 You can modify the font, color, etc. of a face with the set-face-* functions. | |
| 428 | 829 If the face already exists, it is unmodified. |
| 830 If TEMPORARY is non-nil, this face will cease to exist if not in use. | |
| 831 */ | |
| 832 (name, doc_string, temporary)) | |
| 833 { | |
| 834 /* This function can GC if initialized is non-zero */ | |
| 440 | 835 Lisp_Face *f; |
| 428 | 836 Lisp_Object face; |
| 837 | |
| 838 CHECK_SYMBOL (name); | |
| 839 if (!NILP (doc_string)) | |
| 840 CHECK_STRING (doc_string); | |
| 841 | |
| 842 face = Ffind_face (name); | |
| 843 if (!NILP (face)) | |
| 844 return face; | |
| 845 | |
| 846 f = allocate_face (); | |
| 793 | 847 face = wrap_face (f); |
| 428 | 848 |
| 849 f->name = name; | |
| 850 f->doc_string = doc_string; | |
| 851 f->foreground = Fmake_specifier (Qcolor); | |
| 852 set_color_attached_to (f->foreground, face, Qforeground); | |
| 853 f->background = Fmake_specifier (Qcolor); | |
| 854 set_color_attached_to (f->background, face, Qbackground); | |
| 855 f->font = Fmake_specifier (Qfont); | |
| 856 set_font_attached_to (f->font, face, Qfont); | |
| 857 f->background_pixmap = Fmake_specifier (Qimage); | |
| 858 set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap); | |
| 859 f->display_table = Fmake_specifier (Qdisplay_table); | |
| 860 f->underline = Fmake_specifier (Qface_boolean); | |
| 861 set_face_boolean_attached_to (f->underline, face, Qunderline); | |
| 862 f->strikethru = Fmake_specifier (Qface_boolean); | |
| 863 set_face_boolean_attached_to (f->strikethru, face, Qstrikethru); | |
| 864 f->highlight = Fmake_specifier (Qface_boolean); | |
| 865 set_face_boolean_attached_to (f->highlight, face, Qhighlight); | |
| 866 f->dim = Fmake_specifier (Qface_boolean); | |
| 867 set_face_boolean_attached_to (f->dim, face, Qdim); | |
| 868 f->blinking = Fmake_specifier (Qface_boolean); | |
| 869 set_face_boolean_attached_to (f->blinking, face, Qblinking); | |
| 870 f->reverse = Fmake_specifier (Qface_boolean); | |
| 871 set_face_boolean_attached_to (f->reverse, face, Qreverse); | |
| 872 if (!NILP (Vdefault_face)) | |
| 873 { | |
| 874 /* If the default face has already been created, set it as | |
| 875 the default fallback specifier for all the specifiers we | |
| 876 just created. This implements the standard "all faces | |
| 877 inherit from default" behavior. */ | |
| 878 set_specifier_fallback (f->foreground, | |
| 879 Fget (Vdefault_face, Qforeground, Qunbound)); | |
| 880 set_specifier_fallback (f->background, | |
| 881 Fget (Vdefault_face, Qbackground, Qunbound)); | |
| 882 set_specifier_fallback (f->font, | |
| 883 Fget (Vdefault_face, Qfont, Qunbound)); | |
| 884 set_specifier_fallback (f->background_pixmap, | |
| 885 Fget (Vdefault_face, Qbackground_pixmap, | |
| 886 Qunbound)); | |
| 887 set_specifier_fallback (f->display_table, | |
| 888 Fget (Vdefault_face, Qdisplay_table, Qunbound)); | |
| 889 set_specifier_fallback (f->underline, | |
| 890 Fget (Vdefault_face, Qunderline, Qunbound)); | |
| 891 set_specifier_fallback (f->strikethru, | |
| 892 Fget (Vdefault_face, Qstrikethru, Qunbound)); | |
| 893 set_specifier_fallback (f->highlight, | |
| 894 Fget (Vdefault_face, Qhighlight, Qunbound)); | |
| 895 set_specifier_fallback (f->dim, | |
| 896 Fget (Vdefault_face, Qdim, Qunbound)); | |
| 897 set_specifier_fallback (f->blinking, | |
| 898 Fget (Vdefault_face, Qblinking, Qunbound)); | |
| 899 set_specifier_fallback (f->reverse, | |
| 900 Fget (Vdefault_face, Qreverse, Qunbound)); | |
| 901 } | |
| 902 | |
| 903 /* Add the face to the appropriate list. */ | |
| 904 if (NILP (temporary)) | |
| 905 Fputhash (name, face, Vpermanent_faces_cache); | |
| 906 else | |
| 907 Fputhash (name, face, Vtemporary_faces_cache); | |
| 908 | |
| 909 /* Note that it's OK if we dump faces. | |
| 910 When we start up again when we're not noninteractive, | |
| 911 `init-global-faces' is called and it resources all | |
| 912 existing faces. */ | |
| 913 if (initialized && !noninteractive) | |
| 914 { | |
| 915 struct gcpro gcpro1, gcpro2; | |
| 916 | |
| 917 GCPRO2 (name, face); | |
| 918 call1 (Qinit_face_from_resources, name); | |
| 919 UNGCPRO; | |
| 920 } | |
| 921 | |
| 922 return face; | |
| 923 } | |
| 924 | |
| 925 | |
| 926 /***************************************************************************** | |
| 927 initialization code | |
| 928 ****************************************************************************/ | |
| 929 | |
| 930 void | |
| 931 init_global_faces (struct device *d) | |
| 932 { | |
| 933 /* When making the initial terminal device, there is no Lisp code | |
| 934 loaded, so we can't do this. */ | |
| 935 if (initialized && !noninteractive) | |
| 872 | 936 call_critical_lisp_code (d, Qinit_global_faces, wrap_device (d)); |
| 428 | 937 } |
| 938 | |
| 939 void | |
| 940 init_device_faces (struct device *d) | |
| 941 { | |
| 942 /* This function can call lisp */ | |
| 943 | |
| 944 /* When making the initial terminal device, there is no Lisp code | |
| 945 loaded, so we can't do this. */ | |
| 946 if (initialized) | |
| 872 | 947 call_critical_lisp_code (d, Qinit_device_faces, wrap_device (d)); |
| 428 | 948 } |
| 949 | |
| 950 void | |
| 951 init_frame_faces (struct frame *frm) | |
| 952 { | |
| 953 /* When making the initial terminal device, there is no Lisp code | |
| 954 loaded, so we can't do this. */ | |
| 955 if (initialized) | |
| 956 { | |
| 793 | 957 Lisp_Object tframe = wrap_frame (frm); |
| 958 | |
| 428 | 959 |
| 960 /* DO NOT change the selected frame here. If the debugger goes off | |
| 4187 | 961 it will try and display on the frame being created, but it is not |
| 962 ready for that yet and a horrible death will occur. Any random | |
| 963 code depending on the selected-frame as an implicit arg should be | |
| 964 tracked down and shot. For the benefit of the one known, | |
| 965 xpm-color-symbols, make-frame sets the variable | |
| 966 Vframe_being_created to the frame it is making and sets it to nil | |
| 967 when done. Internal functions that this could trigger which are | |
| 968 currently depending on selected-frame should use this instead. It | |
| 969 is not currently visible at the lisp level. */ | |
| 428 | 970 call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)), |
| 971 Qinit_frame_faces, tframe); | |
| 972 } | |
| 973 } | |
| 974 | |
| 975 | |
| 976 /**************************************************************************** | |
| 977 * face cache element functions * | |
| 978 ****************************************************************************/ | |
| 979 | |
| 980 /* | |
| 981 | |
| 982 #### Here is a description of how the face cache elements ought | |
| 983 to be redone. It is *NOT* how they work currently: | |
| 984 | |
| 985 However, when I started to go about implementing this, I realized | |
| 986 that there are all sorts of subtle problems with cache coherency | |
| 987 that are coming up. As it turns out, these problems don't | |
| 988 manifest themselves now due to the brute-force "kill 'em all" | |
| 989 approach to cache invalidation when faces change; but if this | |
| 990 is ever made smarter, these problems are going to come up, and | |
| 991 some of them are very non-obvious. | |
| 992 | |
| 993 I'm thinking of redoing the cache code a bit to avoid these | |
| 994 coherency problems. The bulk of the problems will arise because | |
| 995 the current display structures have simple indices into the | |
| 996 face cache, but the cache can be changed at various times, | |
| 997 which could make the current display structures incorrect. | |
| 998 I guess the dirty and updated flags are an attempt to fix | |
| 999 this, but this approach doesn't really work. | |
| 1000 | |
| 1001 Here's an approach that should keep things clean and unconfused: | |
| 1002 | |
| 1003 1) Imagine a "virtual face cache" that can grow arbitrarily | |
| 1004 big and for which the only thing allowed is to add new | |
| 1005 elements. Existing elements cannot be removed or changed. | |
| 1006 This way, any pointers in the existing redisplay structure | |
| 1007 into the cache never get screwed up. (This is important | |
| 1008 because even if a cache element is out of date, if there's | |
| 1009 a pointer to it then its contents still accurately describe | |
| 1010 the way the text currently looks on the screen.) | |
| 1011 2) Each element in the virtual cache either describes exactly | |
| 1012 one face, or describes the merger of a number of faces | |
| 1013 by some process. In order to simplify things, for mergers | |
| 1014 we do not record which faces or ordering was used, but | |
| 1015 simply that this cache element is the result of merging. | |
| 1016 Unlike the current implementation, it's important that a | |
| 1017 single cache element not be used to both describe a | |
| 1018 single face and describe a merger, even if all the property | |
| 1019 values are the same. | |
| 1020 3) Each cache element can be clean or dirty. "Dirty" means | |
| 1021 that the face that the element points to has been changed; | |
| 1022 this gets set at the time the face is changed. This | |
| 1023 way, when looking up a value in the cache, you can determine | |
| 1024 whether it's out of date or not. For merged faces it | |
| 1025 does not matter -- we don't record the faces or priority | |
| 1026 used to create the merger, so it's impossible to look up | |
| 1027 one of these faces. We have to recompute it each time. | |
| 1028 Luckily, this is fine -- doing the merge is much | |
| 1029 less expensive than recomputing the properties of a | |
| 1030 single face. | |
| 1031 4) For each cache element, we keep a hash value. (In order | |
| 1032 to hash the boolean properties, we convert each of them | |
| 1033 into a different large prime number so that the hashing works | |
| 1034 well.) This allows us, when comparing runes, to properly | |
| 1035 determine whether the face for that rune has changed. | |
| 1036 This will be especially important for TTY's, where there | |
| 1037 aren't that many faces and minimizing redraw is very | |
| 1038 important. | |
| 1039 5) We can't actually keep an infinite cache, but that doesn't | |
| 1040 really matter that much. The only elements we care about | |
| 1041 are those that are used by either the current or desired | |
| 1042 display structs. Therefore, we keep a per-window | |
| 1043 redisplay iteration number, and mark each element with | |
| 1044 that number as we use it. Just after outputting the | |
| 1045 window and synching the redisplay structs, we go through | |
| 1046 the cache and invalidate all elements that are not clean | |
| 1047 elements referring to a particular face and that do not | |
| 1048 have an iteration number equal to the current one. We | |
| 1049 keep them in a chain, and use them to allocate new | |
| 1050 elements when possible instead of increasing the Dynarr. | |
| 1051 | |
| 872 | 1052 --ben (?? At least I think I wrote this!) |
| 428 | 1053 */ |
| 1054 | |
| 1055 /* mark for GC a dynarr of face cachels. */ | |
| 1056 | |
| 1057 void | |
| 1058 mark_face_cachels (face_cachel_dynarr *elements) | |
| 1059 { | |
| 1060 int elt; | |
| 1061 | |
| 1062 if (!elements) | |
| 1063 return; | |
| 1064 | |
| 1065 for (elt = 0; elt < Dynarr_length (elements); elt++) | |
| 1066 { | |
| 1067 struct face_cachel *cachel = Dynarr_atp (elements, elt); | |
| 1068 | |
| 1069 { | |
| 1070 int i; | |
| 1071 | |
| 1072 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1073 if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i])) | |
| 1074 mark_object (cachel->font[i]); | |
| 1075 } | |
| 1076 mark_object (cachel->face); | |
| 1077 mark_object (cachel->foreground); | |
| 1078 mark_object (cachel->background); | |
| 1079 mark_object (cachel->display_table); | |
| 1080 mark_object (cachel->background_pixmap); | |
| 1081 } | |
| 1082 } | |
| 1083 | |
| 1084 /* ensure that the given cachel contains an updated font value for | |
| 3094 | 1085 the given charset. Return the updated font value (which can be |
| 1086 Qunbound, so this value must not be passed unchecked to Lisp). | |
| 1087 | |
| 1088 #### Xft: This function will need to be updated for new font model. */ | |
| 428 | 1089 |
| 1090 Lisp_Object | |
| 1091 ensure_face_cachel_contains_charset (struct face_cachel *cachel, | |
| 1092 Lisp_Object domain, Lisp_Object charset) | |
| 1093 { | |
| 1094 Lisp_Object new_val; | |
| 1095 Lisp_Object face = cachel->face; | |
| 3659 | 1096 int bound = 1, final_stage = 0; |
| 428 | 1097 int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; |
| 1098 | |
| 4187 | 1099 if (!UNBOUNDP (cachel->font[offs]) && |
| 3659 | 1100 bit_vector_bit(FACE_CACHEL_FONT_UPDATED (cachel), offs)) |
| 428 | 1101 return cachel->font[offs]; |
| 1102 | |
| 1103 if (UNBOUNDP (face)) | |
| 1104 { | |
| 1105 /* a merged face. */ | |
| 1106 int i; | |
| 1107 struct window *w = XWINDOW (domain); | |
| 1108 | |
| 1109 new_val = Qunbound; | |
| 3659 | 1110 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 0); |
| 1111 | |
| 428 | 1112 for (i = 0; i < cachel->nfaces; i++) |
| 1113 { | |
| 1114 struct face_cachel *oth; | |
| 1115 | |
| 1116 oth = Dynarr_atp (w->face_cachels, | |
| 1117 FACE_CACHEL_FINDEX_UNSAFE (cachel, i)); | |
| 1118 /* Tout le monde aime la recursion */ | |
| 1119 ensure_face_cachel_contains_charset (oth, domain, charset); | |
| 1120 | |
| 3659 | 1121 if (bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(oth), offs)) |
| 428 | 1122 { |
| 1123 new_val = oth->font[offs]; | |
| 3659 | 1124 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1); |
| 1125 set_bit_vector_bit | |
| 4187 | 1126 (FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, |
| 3659 | 1127 bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(oth), offs)); |
| 428 | 1128 break; |
| 1129 } | |
| 1130 } | |
| 1131 | |
| 3659 | 1132 if (!bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs)) |
| 428 | 1133 /* need to do the default face. */ |
| 1134 { | |
| 1135 struct face_cachel *oth = | |
| 1136 Dynarr_atp (w->face_cachels, DEFAULT_INDEX); | |
| 1137 ensure_face_cachel_contains_charset (oth, domain, charset); | |
| 1138 | |
| 1139 new_val = oth->font[offs]; | |
| 1140 } | |
| 1141 | |
| 4187 | 1142 if (!UNBOUNDP (cachel->font[offs]) && |
| 3659 | 1143 !EQ (cachel->font[offs], new_val)) |
| 428 | 1144 cachel->dirty = 1; |
| 3659 | 1145 set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1); |
| 428 | 1146 cachel->font[offs] = new_val; |
| 3659 | 1147 DEBUG_FACES("just recursed on the unbound face, returning " |
| 1148 "something %s\n", UNBOUNDP(new_val) ? "not bound" | |
| 1149 : "bound"); | |
| 428 | 1150 return new_val; |
| 1151 } | |
| 1152 | |
| 3659 | 1153 do { |
| 1154 | |
| 1155 /* Lookup the face, specifying the initial stage and that fallbacks | |
| 1156 shouldn't happen. */ | |
| 1157 new_val = face_property_matching_instance (face, Qfont, charset, domain, | |
| 1158 /* ERROR_ME_DEBUG_WARN is | |
| 1159 fine here. */ | |
| 1160 ERROR_ME_DEBUG_WARN, 1, Qzero, | |
| 1161 initial); | |
| 1162 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " | |
| 4187 | 1163 "result was something %s\n", |
| 1164 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), | |
| 3659 | 1165 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), |
| 1166 UNBOUNDP(new_val) ? "not bound" : "bound"); | |
| 1167 | |
| 1168 if (!UNBOUNDP (new_val)) break; | |
| 1169 | |
| 1170 bound = 0; | |
| 1171 /* Lookup the face again, this time allowing the fallback. If this | |
| 1172 succeeds, it'll give a font intended for the script in question, | |
| 1173 which is preferable to translating to ISO10646-1 and using the | |
|
4667
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1174 fixed-width fallback. |
|
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1175 |
|
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1176 #### This is questionable. The problem is that unusual scripts |
|
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1177 will typically fallback to the hard-coded values as the user is |
|
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1178 unlikely to have specified them herself, a common complaint. */ |
| 3659 | 1179 new_val = face_property_matching_instance (face, Qfont, |
| 1180 charset, domain, | |
| 1181 ERROR_ME_DEBUG_WARN, 0, | |
| 4187 | 1182 Qzero, |
| 3659 | 1183 initial); |
| 1184 | |
| 1185 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " | |
| 4187 | 1186 "allow fallback, result was something %s\n", |
| 1187 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), | |
| 3659 | 1188 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), |
| 1189 UNBOUNDP(new_val) ? "not bound" : "bound"); | |
| 1190 | |
| 1191 if (!UNBOUNDP(new_val)) | |
| 1192 { | |
| 1193 break; | |
| 1194 } | |
| 1195 | |
| 1196 bound = 1; | |
| 1197 /* Try the face itself with the final-stage specifiers. */ | |
| 1198 new_val = face_property_matching_instance (face, Qfont, | |
| 1199 charset, domain, | |
| 1200 ERROR_ME_DEBUG_WARN, 1, | |
| 4187 | 1201 Qzero, |
| 3659 | 1202 final); |
| 1203 | |
| 1204 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, final, " | |
| 4187 | 1205 "result was something %s\n", |
| 1206 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), | |
| 3659 | 1207 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), |
| 1208 UNBOUNDP(new_val) ? "not bound" : "bound"); | |
| 1209 /* Tell X11 redisplay that it should translate to iso10646-1. */ | |
| 1210 if (!UNBOUNDP(new_val)) | |
| 1211 { | |
| 1212 final_stage = 1; | |
| 1213 break; | |
| 1214 } | |
| 1215 | |
| 1216 bound = 0; | |
| 1217 | |
| 1218 /* Lookup the face again, this time both allowing the fallback and | |
| 1219 allowing its final stage to be used. */ | |
| 1220 new_val = face_property_matching_instance (face, Qfont, | |
| 1221 charset, domain, | |
| 1222 ERROR_ME_DEBUG_WARN, 0, | |
| 4187 | 1223 Qzero, |
| 3659 | 1224 final); |
| 1225 | |
| 1226 DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, " | |
| 4187 | 1227 "allow fallback, result was something %s\n", |
| 1228 XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)), | |
| 3659 | 1229 XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))), |
| 1230 UNBOUNDP(new_val) ? "not bound" : "bound"); | |
| 1231 if (!UNBOUNDP(new_val)) | |
| 1232 { | |
| 1233 /* Tell X11 redisplay that it should translate to iso10646-1. */ | |
| 1234 final_stage = 1; | |
| 1235 break; | |
| 1236 } | |
| 1237 } while (0); | |
| 1238 | |
| 428 | 1239 if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs])) |
| 1240 cachel->dirty = 1; | |
| 3659 | 1241 |
| 1242 set_bit_vector_bit(FACE_CACHEL_FONT_UPDATED(cachel), offs, 1); | |
| 1243 set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, | |
| 1244 final_stage); | |
| 4187 | 1245 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, |
| 3659 | 1246 (bound || EQ (face, Vdefault_face))); |
| 428 | 1247 cachel->font[offs] = new_val; |
| 1248 return new_val; | |
| 1249 } | |
| 1250 | |
| 1251 /* Ensure that the given cachel contains updated fonts for all | |
| 1252 the charsets specified. */ | |
| 1253 | |
| 1254 void | |
| 1255 ensure_face_cachel_complete (struct face_cachel *cachel, | |
| 1256 Lisp_Object domain, unsigned char *charsets) | |
| 1257 { | |
| 1258 int i; | |
| 1259 | |
| 1260 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1261 if (charsets[i]) | |
| 1262 { | |
| 826 | 1263 Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); |
| 428 | 1264 assert (CHARSETP (charset)); |
| 1265 ensure_face_cachel_contains_charset (cachel, domain, charset); | |
| 1266 } | |
| 1267 } | |
| 1268 | |
| 1269 void | |
| 1270 face_cachel_charset_font_metric_info (struct face_cachel *cachel, | |
| 1271 unsigned char *charsets, | |
| 1272 struct font_metric_info *fm) | |
| 1273 { | |
| 1274 int i; | |
| 1275 | |
| 1276 fm->width = 1; | |
| 1277 fm->height = fm->ascent = 1; | |
| 1278 fm->descent = 0; | |
| 1279 fm->proportional_p = 0; | |
| 1280 | |
| 1281 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1282 { | |
| 1283 if (charsets[i]) | |
| 1284 { | |
| 826 | 1285 Lisp_Object charset = charset_by_leading_byte (i + MIN_LEADING_BYTE); |
| 428 | 1286 Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset); |
| 440 | 1287 Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance); |
| 428 | 1288 |
| 1289 assert (CHARSETP (charset)); | |
| 1290 assert (FONT_INSTANCEP (font_instance)); | |
| 1291 | |
| 1292 if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent; | |
| 1293 if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent; | |
| 1294 fm->height = fm->ascent + fm->descent; | |
| 1295 if (fi->proportional_p) | |
| 1296 fm->proportional_p = 1; | |
| 1297 if (EQ (charset, Vcharset_ascii)) | |
| 1298 fm->width = fi->width; | |
| 1299 } | |
| 1300 } | |
| 1301 } | |
| 1302 | |
| 1303 #define FROB(field) \ | |
| 1304 do { \ | |
| 1305 Lisp_Object new_val = \ | |
| 1306 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ | |
| 1307 int bound = 1; \ | |
| 1308 if (UNBOUNDP (new_val)) \ | |
| 1309 { \ | |
| 1310 bound = 0; \ | |
| 1311 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ | |
| 1312 } \ | |
| 1313 if (!EQ (new_val, cachel->field)) \ | |
| 1314 { \ | |
| 1315 cachel->field = new_val; \ | |
| 1316 cachel->dirty = 1; \ | |
| 1317 } \ | |
| 1318 cachel->field##_specified = (bound || default_face); \ | |
| 1319 } while (0) | |
| 1320 | |
| 446 | 1321 /* |
| 1322 * A face's background pixmap will override the face's | |
| 1323 * background color. But the background pixmap of the | |
| 1324 * default face should not override the background color of | |
| 1325 * a face if the background color has been specified or | |
| 1326 * inherited. | |
| 1327 * | |
| 1328 * To accomplish this we remove the background pixmap of the | |
| 1329 * cachel and mark it as having been specified so that cachel | |
| 1330 * merging won't override it later. | |
| 1331 */ | |
| 1332 #define MAYBE_UNFROB_BACKGROUND_PIXMAP \ | |
| 1333 do \ | |
| 1334 { \ | |
| 1335 if (! default_face \ | |
| 1336 && cachel->background_specified \ | |
| 1337 && ! cachel->background_pixmap_specified) \ | |
| 1338 { \ | |
| 1339 cachel->background_pixmap = Qunbound; \ | |
| 1340 cachel->background_pixmap_specified = 1; \ | |
| 1341 } \ | |
| 1342 } while (0) | |
| 1343 | |
| 1344 | |
| 1345 /* Add a cachel for the given face to the given window's cache. */ | |
| 1346 | |
| 1347 static void | |
| 1348 add_face_cachel (struct window *w, Lisp_Object face) | |
| 1349 { | |
| 1350 int must_finish_frobbing = ! WINDOW_FACE_CACHEL (w, DEFAULT_INDEX); | |
| 1351 struct face_cachel new_cachel; | |
| 1352 Lisp_Object domain; | |
| 1353 | |
| 1354 reset_face_cachel (&new_cachel); | |
| 793 | 1355 domain = wrap_window (w); |
| 446 | 1356 update_face_cachel_data (&new_cachel, domain, face); |
| 1357 Dynarr_add (w->face_cachels, new_cachel); | |
| 1358 | |
| 1359 /* The face's background pixmap have not yet been frobbed (see comment | |
|
4667
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1360 in update_face_cachel_data), so we have to do it now */ |
| 446 | 1361 if (must_finish_frobbing) |
| 1362 { | |
| 1363 int default_face = EQ (face, Vdefault_face); | |
|
4844
91b3d00e717f
Various cleanups for Dynarr code, from Unicode-internal ws
Ben Wing <ben@xemacs.org>
parents:
4827
diff
changeset
|
1364 struct face_cachel *cachel = Dynarr_lastp (w->face_cachels); |
| 446 | 1365 |
| 1366 FROB (background_pixmap); | |
| 1367 MAYBE_UNFROB_BACKGROUND_PIXMAP; | |
| 1368 } | |
| 1369 } | |
| 1370 | |
| 1371 /* Called when the updated flag has been cleared on a cachel. | |
| 1372 This function returns 1 if the caller must finish the update (see comment | |
| 1373 below), 0 otherwise. | |
| 1374 */ | |
| 1375 | |
| 1376 void | |
| 1377 update_face_cachel_data (struct face_cachel *cachel, | |
| 1378 Lisp_Object domain, | |
| 1379 Lisp_Object face) | |
| 1380 { | |
| 1381 if (XFACE (face)->dirty || UNBOUNDP (cachel->face)) | |
| 1382 { | |
| 1383 int default_face = EQ (face, Vdefault_face); | |
| 1384 cachel->face = face; | |
| 1385 | |
| 1386 /* We normally only set the _specified flags if the value was | |
| 4187 | 1387 actually bound. The exception is for the default face where |
| 1388 we always set it since it is the ultimate fallback. */ | |
| 446 | 1389 |
| 428 | 1390 FROB (foreground); |
| 1391 FROB (background); | |
| 1392 FROB (display_table); | |
| 446 | 1393 |
| 1394 /* #### WARNING: the background pixmap property of faces is currently | |
| 1395 the only one dealing with images. The problem we have here is that | |
| 1396 frobbing the background pixmap might lead to image instantiation | |
| 1397 which in turn might require that the cache we're building be up to | |
| 1398 date, hence a crash. Here's a typical scenario of this: | |
| 1399 | |
|
4667
cbe5d2169270
Fix typos in face.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4534
diff
changeset
|
1400 - a new window is created and its face cache elements are |
| 446 | 1401 initialized through a call to reset_face_cachels[1]. At that point, |
| 1402 the cache for the default and modeline faces (normaly taken care of | |
| 1403 by redisplay itself) are null. | |
| 1404 - the default face has a background pixmap which needs to be | |
| 1405 instantiated right here, as a consequence of cache initialization. | |
| 1406 - the background pixmap image happens to be instantiated as a string | |
| 1407 (this happens on tty's for instance). | |
| 1408 - In order to do this, we need to compute the string geometry. | |
| 1409 - In order to do this, we might have to access the window's default | |
| 1410 face cache. But this is the cache we're building right now, it is | |
| 1411 null. | |
| 1412 - BARF !!!!! | |
| 428 | 1413 |
| 446 | 1414 To sum up, this means that it is in general unsafe to instantiate |
| 1415 images before face cache updating is complete (appart from image | |
| 1416 related face attributes). The solution we use below is to actually | |
| 1417 detect whether we're building the window's face_cachels for the first | |
| 1418 time, and simply NOT frob the background pixmap in that case. If | |
| 1419 other image-related face attributes are ever implemented, they should | |
| 1420 be protected the same way right here. | |
| 1421 | |
| 1422 One note: | |
| 1423 * See comment in `default_face_font_info' in face.c. Who wrote it ? | |
| 1424 Maybe we have the begining of an answer here ? | |
| 1425 | |
| 1426 Footnotes: | |
| 1427 [1] See comment at the top of `allocate_window' in window.c. | |
| 1428 | |
| 1429 -- didier | |
| 1430 */ | |
| 1431 if (! WINDOWP (domain) | |
| 1432 || WINDOW_FACE_CACHEL (DOMAIN_XWINDOW (domain), DEFAULT_INDEX)) | |
| 428 | 1433 { |
| 446 | 1434 FROB (background_pixmap); |
| 1435 MAYBE_UNFROB_BACKGROUND_PIXMAP; | |
| 428 | 1436 } |
| 1437 #undef FROB | |
| 446 | 1438 #undef MAYBE_UNFROB_BACKGROUND_PIXMAP |
| 428 | 1439 |
| 1440 ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii); | |
| 1441 | |
| 1442 #define FROB(field) \ | |
| 1443 do { \ | |
| 1444 Lisp_Object new_val = \ | |
| 1445 FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ | |
| 1446 int bound = 1; \ | |
| 1447 unsigned int new_val_int; \ | |
| 1448 if (UNBOUNDP (new_val)) \ | |
| 1449 { \ | |
| 1450 bound = 0; \ | |
| 1451 new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ | |
| 1452 } \ | |
| 1453 new_val_int = EQ (new_val, Qt); \ | |
| 1454 if (cachel->field != new_val_int) \ | |
| 1455 { \ | |
| 1456 cachel->field = new_val_int; \ | |
| 1457 cachel->dirty = 1; \ | |
| 1458 } \ | |
| 1459 cachel->field##_specified = bound; \ | |
| 1460 } while (0) | |
| 1461 | |
| 1462 FROB (underline); | |
| 1463 FROB (strikethru); | |
| 1464 FROB (highlight); | |
| 1465 FROB (dim); | |
| 1466 FROB (reverse); | |
| 1467 FROB (blinking); | |
| 1468 #undef FROB | |
| 1469 } | |
| 1470 | |
| 1471 cachel->updated = 1; | |
| 1472 } | |
| 1473 | |
| 1474 /* Merge the cachel identified by FINDEX in window W into the given | |
| 1475 cachel. */ | |
| 1476 | |
| 1477 static void | |
| 1478 merge_face_cachel_data (struct window *w, face_index findex, | |
| 1479 struct face_cachel *cachel) | |
| 1480 { | |
| 3659 | 1481 int offs; |
| 1482 | |
| 428 | 1483 #define FINDEX_FIELD(field) \ |
| 1484 Dynarr_atp (w->face_cachels, findex)->field | |
| 1485 | |
| 1486 #define FROB(field) \ | |
| 1487 do { \ | |
| 1488 if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \ | |
| 1489 { \ | |
| 1490 cachel->field = FINDEX_FIELD (field); \ | |
| 1491 cachel->field##_specified = 1; \ | |
| 1492 cachel->dirty = 1; \ | |
| 1493 } \ | |
| 1494 } while (0) | |
| 1495 | |
| 1496 FROB (foreground); | |
| 1497 FROB (background); | |
| 1498 FROB (display_table); | |
| 1499 FROB (background_pixmap); | |
| 1500 FROB (underline); | |
| 1501 FROB (strikethru); | |
| 1502 FROB (highlight); | |
| 1503 FROB (dim); | |
| 1504 FROB (reverse); | |
| 1505 FROB (blinking); | |
| 1506 | |
| 3659 | 1507 for (offs = 0; offs < NUM_LEADING_BYTES; ++offs) |
| 1508 { | |
| 1509 if (!(bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs)) | |
| 1510 && bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED | |
| 1511 (Dynarr_atp(w->face_cachels, findex)), offs)) | |
| 1512 { | |
| 1513 cachel->font[offs] = FINDEX_FIELD (font[offs]); | |
| 1514 set_bit_vector_bit(FACE_CACHEL_FONT_SPECIFIED(cachel), offs, 1); | |
| 1515 /* Also propagate whether we're translating to Unicode for the | |
| 1516 given face. */ | |
| 4187 | 1517 set_bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE(cachel), offs, |
| 3659 | 1518 bit_vector_bit(FACE_CACHEL_FONT_FINAL_STAGE |
| 1519 (Dynarr_atp(w->face_cachels, | |
| 1520 findex)), offs)); | |
| 1521 cachel->dirty = 1; | |
| 1522 } | |
| 1523 } | |
| 428 | 1524 #undef FROB |
| 1525 #undef FINDEX_FIELD | |
| 1526 | |
| 1527 cachel->updated = 1; | |
| 1528 } | |
| 1529 | |
| 1530 /* Initialize a cachel. */ | |
| 3094 | 1531 /* #### Xft: this function will need to be changed for new font model. */ |
| 428 | 1532 |
| 1533 void | |
| 1534 reset_face_cachel (struct face_cachel *cachel) | |
| 1535 { | |
| 1536 xzero (*cachel); | |
| 1537 cachel->face = Qunbound; | |
| 1538 cachel->nfaces = 0; | |
| 1539 cachel->merged_faces = 0; | |
| 1540 cachel->foreground = Qunbound; | |
| 1541 cachel->background = Qunbound; | |
| 1542 { | |
| 1543 int i; | |
| 1544 | |
| 1545 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1546 cachel->font[i] = Qunbound; | |
| 1547 } | |
| 1548 cachel->display_table = Qunbound; | |
| 1549 cachel->background_pixmap = Qunbound; | |
| 3659 | 1550 FACE_CACHEL_FONT_SPECIFIED (cachel)->size = sizeof(cachel->font_specified); |
| 1551 FACE_CACHEL_FONT_UPDATED (cachel)->size = sizeof(cachel->font_updated); | |
| 428 | 1552 } |
| 1553 | |
| 1554 /* Retrieve the index to a cachel for window W that corresponds to | |
| 1555 the specified face. If necessary, add a new element to the | |
| 1556 cache. */ | |
| 1557 | |
| 1558 face_index | |
| 1559 get_builtin_face_cache_index (struct window *w, Lisp_Object face) | |
| 1560 { | |
| 1561 int elt; | |
| 1562 | |
| 1563 if (noninteractive) | |
| 1564 return 0; | |
| 1565 | |
| 1566 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
| 1567 { | |
| 1568 struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt); | |
| 1569 | |
| 1570 if (EQ (cachel->face, face)) | |
| 1571 { | |
| 793 | 1572 Lisp_Object window = wrap_window (w); |
| 1573 | |
| 428 | 1574 if (!cachel->updated) |
| 1575 update_face_cachel_data (cachel, window, face); | |
| 1576 return elt; | |
| 1577 } | |
| 1578 } | |
| 1579 | |
| 1580 /* If we didn't find the face, add it and then return its index. */ | |
| 1581 add_face_cachel (w, face); | |
| 1582 return elt; | |
| 1583 } | |
| 1584 | |
| 1585 void | |
| 1586 reset_face_cachels (struct window *w) | |
| 1587 { | |
| 1588 /* #### Not initialized in batch mode for the stream device. */ | |
| 1589 if (w->face_cachels) | |
| 1590 { | |
| 1591 int i; | |
| 4208 | 1592 face_index fi; |
| 428 | 1593 |
| 1594 for (i = 0; i < Dynarr_length (w->face_cachels); i++) | |
| 1595 { | |
| 1596 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i); | |
| 1597 if (cachel->merged_faces) | |
| 1598 Dynarr_free (cachel->merged_faces); | |
| 1599 } | |
| 1600 Dynarr_reset (w->face_cachels); | |
| 4187 | 1601 /* #### NOTE: be careful with the order ! |
| 1602 The cpp macros DEFAULT_INDEX and MODELINE_INDEX defined in | |
| 4208 | 1603 redisplay.h depend on the code below. Please make sure to assert the |
| 1604 correct values if you ever add new built-in faces here. | |
| 4187 | 1605 -- dvl */ |
| 4208 | 1606 fi = get_builtin_face_cache_index (w, Vdefault_face); |
| 4210 | 1607 assert (noninteractive || fi == DEFAULT_INDEX); |
| 4208 | 1608 fi = get_builtin_face_cache_index (w, Vmodeline_face); |
| 4210 | 1609 assert (noninteractive || fi == MODELINE_INDEX); |
| 428 | 1610 XFRAME (w->frame)->window_face_cache_reset = 1; |
| 1611 } | |
| 1612 } | |
| 1613 | |
| 1614 void | |
| 1615 mark_face_cachels_as_clean (struct window *w) | |
| 1616 { | |
| 1617 int elt; | |
| 1618 | |
| 1619 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
| 1620 Dynarr_atp (w->face_cachels, elt)->dirty = 0; | |
| 1621 } | |
| 1622 | |
| 3094 | 1623 /* #### Xft: this function will need to be changed for new font model. */ |
| 428 | 1624 void |
| 1625 mark_face_cachels_as_not_updated (struct window *w) | |
| 1626 { | |
| 1627 int elt; | |
| 1628 | |
| 1629 for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) | |
| 1630 { | |
| 1631 struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt); | |
| 1632 | |
| 1633 cachel->updated = 0; | |
| 4187 | 1634 memset(FACE_CACHEL_FONT_UPDATED(cachel)->bits, 0, |
| 3659 | 1635 BIT_VECTOR_LONG_STORAGE (NUM_LEADING_BYTES)); |
| 428 | 1636 } |
| 1637 } | |
| 1638 | |
| 1639 #ifdef MEMORY_USAGE_STATS | |
| 1640 | |
| 1641 int | |
| 1642 compute_face_cachel_usage (face_cachel_dynarr *face_cachels, | |
| 1643 struct overhead_stats *ovstats) | |
| 1644 { | |
| 1645 int total = 0; | |
| 1646 | |
| 1647 if (face_cachels) | |
| 1648 { | |
| 1649 int i; | |
| 1650 | |
| 1651 total += Dynarr_memory_usage (face_cachels, ovstats); | |
| 1652 for (i = 0; i < Dynarr_length (face_cachels); i++) | |
| 1653 { | |
| 1654 int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces; | |
| 1655 if (merged) | |
| 1656 total += Dynarr_memory_usage (merged, ovstats); | |
| 1657 } | |
| 1658 } | |
| 1659 | |
| 1660 return total; | |
| 1661 } | |
| 1662 | |
| 1663 #endif /* MEMORY_USAGE_STATS */ | |
| 1664 | |
| 1665 | |
| 1666 /***************************************************************************** | |
| 1667 * merged face functions * | |
| 1668 *****************************************************************************/ | |
| 1669 | |
| 1670 /* Compare two merged face cachels to determine whether we have to add | |
| 1671 a new entry to the face cache. | |
| 1672 | |
| 1673 Note that we do not compare the attributes, but just the faces the | |
| 1674 cachels are based on. If they are the same, then the cachels certainly | |
| 1675 ought to have the same attributes, except in the case where fonts | |
| 1676 for different charsets have been determined in the two -- and in that | |
| 1677 case this difference is fine. */ | |
| 1678 | |
| 1679 static int | |
| 1680 compare_merged_face_cachels (struct face_cachel *cachel1, | |
| 1681 struct face_cachel *cachel2) | |
| 1682 { | |
| 1683 int i; | |
| 1684 | |
| 1685 if (!EQ (cachel1->face, cachel2->face) | |
| 1686 || cachel1->nfaces != cachel2->nfaces) | |
| 1687 return 0; | |
| 1688 | |
| 1689 for (i = 0; i < cachel1->nfaces; i++) | |
| 1690 if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i) | |
| 1691 != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i)) | |
| 1692 return 0; | |
| 1693 | |
| 1694 return 1; | |
| 1695 } | |
| 1696 | |
| 1697 /* Retrieve the index to a cachel for window W that corresponds to | |
| 1698 the specified cachel. If necessary, add a new element to the | |
| 1699 cache. This is similar to get_builtin_face_cache_index() but | |
| 1700 is intended for merged cachels rather than for cachels representing | |
| 1701 just a face. | |
| 1702 | |
| 1703 Note that a merged cachel for just one face is not the same as | |
| 1704 the simple cachel for that face, because it is also merged with | |
| 1705 the default face. */ | |
| 1706 | |
| 1707 static face_index | |
| 1708 get_merged_face_cache_index (struct window *w, | |
| 1709 struct face_cachel *merged_cachel) | |
| 1710 { | |
| 1711 int elt; | |
| 1712 int cache_size = Dynarr_length (w->face_cachels); | |
| 1713 | |
| 1714 for (elt = 0; elt < cache_size; elt++) | |
| 1715 { | |
| 1716 struct face_cachel *cachel = | |
| 1717 Dynarr_atp (w->face_cachels, elt); | |
| 1718 | |
| 1719 if (compare_merged_face_cachels (cachel, merged_cachel)) | |
| 1720 return elt; | |
| 1721 } | |
| 1722 | |
| 1723 /* We didn't find it so add this instance to the cache. */ | |
| 1724 merged_cachel->updated = 1; | |
| 1725 merged_cachel->dirty = 1; | |
| 1726 Dynarr_add (w->face_cachels, *merged_cachel); | |
| 1727 return cache_size; | |
| 1728 } | |
| 1729 | |
| 1730 face_index | |
| 1731 get_extent_fragment_face_cache_index (struct window *w, | |
| 1732 struct extent_fragment *ef) | |
| 1733 { | |
| 1734 struct face_cachel cachel; | |
| 1735 int len = Dynarr_length (ef->extents); | |
| 1736 face_index findex = 0; | |
| 1737 | |
| 1738 /* Optimize the default case. */ | |
| 1739 if (len == 0) | |
| 1740 return DEFAULT_INDEX; | |
| 1741 else | |
| 1742 { | |
| 1743 int i; | |
| 1744 | |
| 1745 /* Merge the faces of the extents together in order. */ | |
| 1746 | |
| 1747 reset_face_cachel (&cachel); | |
| 1748 | |
| 1749 for (i = len - 1; i >= 0; i--) | |
| 1750 { | |
| 1751 EXTENT current = Dynarr_at (ef->extents, i); | |
| 1752 int has_findex = 0; | |
| 1753 Lisp_Object face = extent_face (current); | |
| 1754 | |
| 1755 if (FACEP (face)) | |
| 1756 { | |
| 1757 findex = get_builtin_face_cache_index (w, face); | |
| 1758 has_findex = 1; | |
| 1759 merge_face_cachel_data (w, findex, &cachel); | |
| 1760 } | |
| 1761 /* remember, we're called from within redisplay | |
| 1762 so we can't error. */ | |
| 1763 else while (CONSP (face)) | |
| 1764 { | |
| 1765 Lisp_Object one_face = XCAR (face); | |
| 1766 if (FACEP (one_face)) | |
| 1767 { | |
| 1768 findex = get_builtin_face_cache_index (w, one_face); | |
| 1769 merge_face_cachel_data (w, findex, &cachel); | |
| 1770 | |
| 1771 /* code duplication here but there's no clean | |
| 1772 way to avoid it. */ | |
| 1773 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES) | |
| 1774 { | |
| 1775 if (!cachel.merged_faces) | |
| 1776 cachel.merged_faces = Dynarr_new (int); | |
| 1777 Dynarr_add (cachel.merged_faces, findex); | |
| 1778 } | |
| 1779 else | |
| 1780 cachel.merged_faces_static[cachel.nfaces] = findex; | |
| 1781 cachel.nfaces++; | |
| 1782 } | |
| 1783 face = XCDR (face); | |
| 1784 } | |
| 1785 | |
| 1786 if (has_findex) | |
| 1787 { | |
| 1788 if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES) | |
| 1789 { | |
| 1790 if (!cachel.merged_faces) | |
| 1791 cachel.merged_faces = Dynarr_new (int); | |
| 1792 Dynarr_add (cachel.merged_faces, findex); | |
| 1793 } | |
| 1794 else | |
| 1795 cachel.merged_faces_static[cachel.nfaces] = findex; | |
| 1796 cachel.nfaces++; | |
| 1797 } | |
| 1798 } | |
| 1799 | |
| 1800 /* Now finally merge in the default face. */ | |
| 1801 findex = get_builtin_face_cache_index (w, Vdefault_face); | |
| 1802 merge_face_cachel_data (w, findex, &cachel); | |
| 1803 | |
| 444 | 1804 findex = get_merged_face_cache_index (w, &cachel); |
| 1805 if (cachel.merged_faces && | |
| 1806 /* merged_faces did not get stored and available via return value */ | |
| 1807 Dynarr_at (w->face_cachels, findex).merged_faces != | |
| 1808 cachel.merged_faces) | |
| 1809 { | |
| 1810 Dynarr_free (cachel.merged_faces); | |
| 1811 cachel.merged_faces = 0; | |
| 1812 } | |
| 1813 return findex; | |
| 428 | 1814 } |
| 1815 } | |
| 1816 | |
| 3094 | 1817 /* Return a cache index for window W from merging the faces in FACE_LIST. |
| 1818 COUNT is the number of faces in the list. | |
| 1819 | |
| 1820 The default face should not be included in the list, as it is always | |
| 1821 implicitly merged into the cachel. | |
| 1822 | |
| 1823 WARNING: this interface may change. */ | |
| 1824 | |
| 1825 face_index | |
| 1826 merge_face_list_to_cache_index (struct window *w, | |
| 1827 Lisp_Object *face_list, int count) | |
| 1828 { | |
| 1829 int i; | |
| 1830 face_index findex = 0; | |
| 1831 struct face_cachel cachel; | |
| 1832 | |
| 1833 reset_face_cachel (&cachel); | |
| 1834 | |
| 1835 for (i = 0; i < count; i++) | |
| 1836 { | |
| 1837 Lisp_Object face = face_list[i]; | |
| 1838 | |
| 1839 if (!NILP (face)) | |
| 1840 { | |
| 1841 CHECK_FACE(face); /* #### presumably unnecessary */ | |
| 1842 findex = get_builtin_face_cache_index (w, face); | |
| 1843 merge_face_cachel_data (w, findex, &cachel); | |
| 1844 } | |
| 1845 } | |
| 1846 | |
| 1847 /* Now finally merge in the default face. */ | |
| 1848 findex = get_builtin_face_cache_index (w, Vdefault_face); | |
| 1849 merge_face_cachel_data (w, findex, &cachel); | |
| 1850 | |
| 1851 return get_merged_face_cache_index (w, &cachel); | |
| 1852 } | |
| 1853 | |
| 428 | 1854 |
| 1855 /***************************************************************************** | |
| 1856 interface functions | |
| 1857 ****************************************************************************/ | |
| 1858 | |
| 1859 static void | |
| 1860 update_EmacsFrame (Lisp_Object frame, Lisp_Object name) | |
| 1861 { | |
| 1862 struct frame *frm = XFRAME (frame); | |
| 1863 | |
| 3676 | 1864 if (!FRAME_LIVE_P(frm)) |
| 1865 return; | |
| 1866 | |
| 428 | 1867 if (EQ (name, Qfont)) |
| 1868 MARK_FRAME_SIZE_SLIPPED (frm); | |
| 1869 | |
| 1870 MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name)); | |
| 1871 } | |
| 1872 | |
| 1873 static void | |
| 1874 update_EmacsFrames (Lisp_Object locale, Lisp_Object name) | |
| 1875 { | |
| 1876 if (FRAMEP (locale)) | |
| 1877 { | |
| 1878 update_EmacsFrame (locale, name); | |
| 1879 } | |
| 1880 else if (DEVICEP (locale)) | |
| 1881 { | |
| 1882 Lisp_Object frmcons; | |
| 1883 | |
| 1884 DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale)) | |
| 1885 update_EmacsFrame (XCAR (frmcons), name); | |
| 1886 } | |
| 1887 else if (EQ (locale, Qglobal) || EQ (locale, Qfallback)) | |
| 1888 { | |
| 1889 Lisp_Object frmcons, devcons, concons; | |
| 1890 | |
| 1891 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) | |
| 1892 update_EmacsFrame (XCAR (frmcons), name); | |
| 1893 } | |
| 1894 } | |
| 1895 | |
| 1896 void | |
| 1897 update_frame_face_values (struct frame *f) | |
| 1898 { | |
| 793 | 1899 Lisp_Object frm = wrap_frame (f); |
| 428 | 1900 |
| 1901 update_EmacsFrame (frm, Qforeground); | |
| 1902 update_EmacsFrame (frm, Qbackground); | |
| 1903 update_EmacsFrame (frm, Qfont); | |
| 1904 } | |
| 1905 | |
| 1906 void | |
| 1907 face_property_was_changed (Lisp_Object face, Lisp_Object property, | |
| 1908 Lisp_Object locale) | |
| 1909 { | |
| 1910 int default_face = EQ (face, Vdefault_face); | |
| 1911 | |
| 1912 /* If the locale could affect the frame value, then call | |
| 1913 update_EmacsFrames just in case. */ | |
| 1914 if (default_face && | |
| 1915 (EQ (property, Qforeground) || | |
| 1916 EQ (property, Qbackground) || | |
| 1917 EQ (property, Qfont))) | |
| 1918 update_EmacsFrames (locale, property); | |
| 1919 | |
| 1920 if (WINDOWP (locale)) | |
| 1921 { | |
| 1922 MARK_FRAME_FACES_CHANGED (XFRAME (XWINDOW (locale)->frame)); | |
| 1923 } | |
| 1924 else if (FRAMEP (locale)) | |
| 1925 { | |
| 1926 MARK_FRAME_FACES_CHANGED (XFRAME (locale)); | |
| 1927 } | |
| 1928 else if (DEVICEP (locale)) | |
| 1929 { | |
| 1930 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (locale)); | |
| 1931 } | |
| 1932 else | |
| 1933 { | |
| 1934 Lisp_Object devcons, concons; | |
| 1935 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 1936 MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons))); | |
| 1937 } | |
| 1938 | |
| 1939 /* | |
| 1940 * This call to update_faces_inheritance isn't needed and makes | |
| 1941 * creating and modifying faces _very_ slow. The point of | |
| 1942 * update_face_inheritances is to find all faces that inherit | |
| 1943 * directly from this face property and set the specifier "dirty" | |
| 1944 * flag on the corresponding specifier. This forces recaching of | |
| 1945 * cached specifier values in frame and window struct slots. But | |
| 1946 * currently no face properties are cached in frame and window | |
| 1947 * struct slots, so calling this function does nothing useful! | |
| 1948 * | |
| 1949 * Further, since update_faces_inheritance maps over the whole | |
| 1950 * face table every time it is called, it gets terribly slow when | |
| 1951 * there are many faces. Creating 500 faces on a 50Mhz 486 took | |
| 1952 * 433 seconds when update_faces_inheritance was called. With the | |
| 1953 * call commented out, creating those same 500 faces took 0.72 | |
| 1954 * seconds. | |
| 1955 */ | |
| 1956 /* update_faces_inheritance (face, property);*/ | |
| 1957 XFACE (face)->dirty = 1; | |
| 1958 } | |
| 1959 | |
| 1960 DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /* | |
| 1961 Define and return a new face which is a copy of an existing one, | |
| 1962 or makes an already-existing face be exactly like another. | |
| 1963 LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'. | |
| 1964 */ | |
| 1965 (old_face, new_name, locale, tag_set, exact_p, how_to_add)) | |
| 1966 { | |
| 440 | 1967 Lisp_Face *fold, *fnew; |
| 428 | 1968 Lisp_Object new_face = Qnil; |
| 1969 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 1970 | |
| 1971 old_face = Fget_face (old_face); | |
| 1972 | |
| 1973 /* We GCPRO old_face because it might be temporary, and GCing could | |
| 1974 occur in various places below. */ | |
| 1975 GCPRO4 (tag_set, locale, old_face, new_face); | |
| 1976 /* check validity of how_to_add now. */ | |
| 1977 decode_how_to_add_specification (how_to_add); | |
| 1978 /* and of tag_set. */ | |
| 1979 tag_set = decode_specifier_tag_set (tag_set); | |
| 1980 /* and of locale. */ | |
| 1981 locale = decode_locale_list (locale); | |
| 1982 | |
| 1983 new_face = Ffind_face (new_name); | |
| 1984 if (NILP (new_face)) | |
| 1985 { | |
| 1986 Lisp_Object temp; | |
| 1987 | |
| 1988 CHECK_SYMBOL (new_name); | |
| 1989 | |
| 1990 /* Create the new face with the same status as the old face. */ | |
| 1991 temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil)) | |
| 1992 ? Qnil | |
| 1993 : Qt); | |
| 1994 | |
| 1995 new_face = Fmake_face (new_name, Qnil, temp); | |
| 1996 } | |
| 1997 | |
| 1998 fold = XFACE (old_face); | |
| 1999 fnew = XFACE (new_face); | |
| 2000 | |
| 2001 #define COPY_PROPERTY(property) \ | |
| 2002 Fcopy_specifier (fold->property, fnew->property, \ | |
| 4187 | 2003 locale, tag_set, exact_p, how_to_add); |
| 428 | 2004 |
| 2005 COPY_PROPERTY (foreground); | |
| 2006 COPY_PROPERTY (background); | |
| 2007 COPY_PROPERTY (font); | |
| 2008 COPY_PROPERTY (display_table); | |
| 2009 COPY_PROPERTY (background_pixmap); | |
| 2010 COPY_PROPERTY (underline); | |
| 2011 COPY_PROPERTY (strikethru); | |
| 2012 COPY_PROPERTY (highlight); | |
| 2013 COPY_PROPERTY (dim); | |
| 2014 COPY_PROPERTY (blinking); | |
| 2015 COPY_PROPERTY (reverse); | |
| 2016 #undef COPY_PROPERTY | |
| 2017 /* #### should it copy the individual specifiers, if they exist? */ | |
| 2018 fnew->plist = Fcopy_sequence (fold->plist); | |
| 2019 | |
| 2020 UNGCPRO; | |
| 2021 | |
| 2022 return new_name; | |
| 2023 } | |
| 2024 | |
| 3659 | 2025 #ifdef MULE |
| 2026 | |
| 3918 | 2027 Lisp_Object Qone_dimensional, Qtwo_dimensional, Qx_coverage_instantiator; |
| 3659 | 2028 |
| 4187 | 2029 DEFUN ("specifier-tag-one-dimensional-p", |
| 2030 Fspecifier_tag_one_dimensional_p, | |
| 3659 | 2031 2, 2, 0, /* |
| 2032 Return non-nil if (charset-dimension CHARSET) is 1. | |
| 2033 | |
| 2034 Used by the X11 platform font code; see `define-specifier-tag'. You | |
| 2035 shouldn't ever need to call this yourself. | |
| 2036 */ | |
| 2037 (charset, UNUSED(stage))) | |
| 2038 { | |
| 2039 CHECK_CHARSET(charset); | |
| 2040 return (1 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil; | |
| 2041 } | |
| 2042 | |
| 4187 | 2043 DEFUN ("specifier-tag-two-dimensional-p", |
| 2044 Fspecifier_tag_two_dimensional_p, | |
| 3659 | 2045 2, 2, 0, /* |
| 2046 Return non-nil if (charset-dimension CHARSET) is 2. | |
| 2047 | |
| 2048 Used by the X11 platform font code; see `define-specifier-tag'. You | |
| 2049 shouldn't ever need to call this yourself. | |
| 2050 */ | |
| 2051 (charset, UNUSED(stage))) | |
| 2052 { | |
| 2053 CHECK_CHARSET(charset); | |
| 2054 return (2 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil; | |
| 2055 } | |
| 2056 | |
| 4187 | 2057 DEFUN ("specifier-tag-final-stage-p", |
| 2058 Fspecifier_tag_final_stage_p, | |
| 3659 | 2059 2, 2, 0, /* |
| 2060 Return non-nil if STAGE is 'final. | |
| 2061 | |
| 2062 Used by the X11 platform font code for giving fallbacks; see | |
| 4187 | 2063 `define-specifier-tag'. You shouldn't ever need to call this. |
| 3659 | 2064 */ |
| 2065 (UNUSED(charset), stage)) | |
| 2066 { | |
| 2067 return EQ(stage, Qfinal) ? Qt : Qnil; | |
| 2068 } | |
| 2069 | |
| 4187 | 2070 DEFUN ("specifier-tag-initial-stage-p", |
| 2071 Fspecifier_tag_initial_stage_p, | |
| 3659 | 2072 2, 2, 0, /* |
| 2073 Return non-nil if STAGE is 'initial. | |
| 2074 | |
| 2075 Used by the X11 platform font code for giving fallbacks; see | |
| 4187 | 2076 `define-specifier-tag'. You shouldn't ever need to call this. |
| 3659 | 2077 */ |
| 2078 (UNUSED(charset), stage)) | |
| 2079 { | |
| 2080 return EQ(stage, Qinitial) ? Qt : Qnil; | |
| 2081 } | |
| 2082 | |
| 4187 | 2083 DEFUN ("specifier-tag-encode-as-utf-8-p", |
| 2084 Fspecifier_tag_encode_as_utf_8_p, | |
| 3659 | 2085 2, 2, 0, /* |
| 2086 Return t if and only if (charset-property CHARSET 'encode-as-utf-8)). | |
| 2087 | |
| 2088 Used by the X11 platform font code; see `define-specifier-tag'. You | |
| 2089 shouldn't ever need to call this. | |
| 2090 */ | |
| 2091 (charset, UNUSED(stage))) | |
| 2092 { | |
| 2093 /* Used to check that the stage was initial too. */ | |
| 2094 CHECK_CHARSET(charset); | |
| 2095 return XCHARSET_ENCODE_AS_UTF_8(charset) ? Qt : Qnil; | |
| 2096 } | |
| 2097 | |
| 2098 #endif /* MULE */ | |
| 2099 | |
| 428 | 2100 |
| 2101 void | |
| 2102 syms_of_faces (void) | |
| 2103 { | |
| 442 | 2104 INIT_LRECORD_IMPLEMENTATION (face); |
| 2105 | |
| 440 | 2106 /* Qdefault, Qwidget, Qleft_margin, Qright_margin defined in general.c */ |
| 563 | 2107 DEFSYMBOL (Qmodeline); |
| 2108 DEFSYMBOL (Qgui_element); | |
| 2109 DEFSYMBOL (Qtext_cursor); | |
| 2110 DEFSYMBOL (Qvertical_divider); | |
| 428 | 2111 |
| 2112 DEFSUBR (Ffacep); | |
| 2113 DEFSUBR (Ffind_face); | |
| 2114 DEFSUBR (Fget_face); | |
| 2115 DEFSUBR (Fface_name); | |
| 2116 DEFSUBR (Fbuilt_in_face_specifiers); | |
| 2117 DEFSUBR (Fface_list); | |
| 2118 DEFSUBR (Fmake_face); | |
| 2119 DEFSUBR (Fcopy_face); | |
| 2120 | |
| 3659 | 2121 #ifdef MULE |
| 2122 DEFSYMBOL (Qone_dimensional); | |
| 2123 DEFSYMBOL (Qtwo_dimensional); | |
| 3918 | 2124 DEFSYMBOL (Qx_coverage_instantiator); |
| 2125 | |
| 3659 | 2126 /* I would much prefer these were in Lisp. */ |
| 2127 DEFSUBR (Fspecifier_tag_one_dimensional_p); | |
| 2128 DEFSUBR (Fspecifier_tag_two_dimensional_p); | |
| 2129 DEFSUBR (Fspecifier_tag_initial_stage_p); | |
| 2130 DEFSUBR (Fspecifier_tag_final_stage_p); | |
| 2131 DEFSUBR (Fspecifier_tag_encode_as_utf_8_p); | |
| 2132 #endif /* MULE */ | |
| 2133 | |
| 563 | 2134 DEFSYMBOL (Qfacep); |
| 2135 DEFSYMBOL (Qforeground); | |
| 2136 DEFSYMBOL (Qbackground); | |
| 428 | 2137 /* Qfont defined in general.c */ |
| 563 | 2138 DEFSYMBOL (Qdisplay_table); |
| 2139 DEFSYMBOL (Qbackground_pixmap); | |
| 2140 DEFSYMBOL (Qunderline); | |
| 2141 DEFSYMBOL (Qstrikethru); | |
| 428 | 2142 /* Qhighlight, Qreverse defined in general.c */ |
| 563 | 2143 DEFSYMBOL (Qdim); |
| 2144 DEFSYMBOL (Qblinking); | |
| 428 | 2145 |
| 2865 | 2146 DEFSYMBOL (Qface_alias); |
| 2867 | 2147 DEFERROR_STANDARD (Qcyclic_face_alias, Qinvalid_state); |
| 2865 | 2148 |
| 563 | 2149 DEFSYMBOL (Qinit_face_from_resources); |
| 2150 DEFSYMBOL (Qinit_global_faces); | |
| 2151 DEFSYMBOL (Qinit_device_faces); | |
| 2152 DEFSYMBOL (Qinit_frame_faces); | |
| 428 | 2153 } |
| 2154 | |
| 2155 void | |
| 2156 structure_type_create_faces (void) | |
| 2157 { | |
| 2158 struct structure_type *st; | |
| 2159 | |
| 2160 st = define_structure_type (Qface, face_validate, face_instantiate); | |
| 2161 | |
| 2162 define_structure_type_keyword (st, Qname, face_name_validate); | |
| 2163 } | |
| 2164 | |
| 2165 void | |
| 2166 vars_of_faces (void) | |
| 2167 { | |
| 2168 staticpro (&Vpermanent_faces_cache); | |
| 771 | 2169 Vpermanent_faces_cache = |
| 2170 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 428 | 2171 staticpro (&Vtemporary_faces_cache); |
| 771 | 2172 Vtemporary_faces_cache = |
| 2173 make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ); | |
| 428 | 2174 |
| 2175 staticpro (&Vdefault_face); | |
| 2176 Vdefault_face = Qnil; | |
| 2177 staticpro (&Vgui_element_face); | |
| 2178 Vgui_element_face = Qnil; | |
| 2179 staticpro (&Vwidget_face); | |
| 2180 Vwidget_face = Qnil; | |
| 2181 staticpro (&Vmodeline_face); | |
| 2182 Vmodeline_face = Qnil; | |
| 2183 staticpro (&Vtoolbar_face); | |
| 2184 Vtoolbar_face = Qnil; | |
| 2185 | |
| 2186 staticpro (&Vvertical_divider_face); | |
| 2187 Vvertical_divider_face = Qnil; | |
| 2188 staticpro (&Vleft_margin_face); | |
| 2189 Vleft_margin_face = Qnil; | |
| 2190 staticpro (&Vright_margin_face); | |
| 2191 Vright_margin_face = Qnil; | |
| 2192 staticpro (&Vtext_cursor_face); | |
| 2193 Vtext_cursor_face = Qnil; | |
| 2194 staticpro (&Vpointer_face); | |
| 2195 Vpointer_face = Qnil; | |
| 2196 | |
| 3659 | 2197 #ifdef DEBUG_XEMACS |
| 2198 DEFVAR_INT ("debug-x-faces", &debug_x_faces /* | |
| 2199 If non-zero, display debug information about X faces | |
| 2200 */ ); | |
| 2201 debug_x_faces = 0; | |
| 2202 #endif | |
| 2203 | |
| 428 | 2204 { |
| 2205 Lisp_Object syms[20]; | |
| 2206 int n = 0; | |
| 2207 | |
| 2208 syms[n++] = Qforeground; | |
| 2209 syms[n++] = Qbackground; | |
| 2210 syms[n++] = Qfont; | |
| 2211 syms[n++] = Qdisplay_table; | |
| 2212 syms[n++] = Qbackground_pixmap; | |
| 2213 syms[n++] = Qunderline; | |
| 2214 syms[n++] = Qstrikethru; | |
| 2215 syms[n++] = Qhighlight; | |
| 2216 syms[n++] = Qdim; | |
| 2217 syms[n++] = Qblinking; | |
| 2218 syms[n++] = Qreverse; | |
| 2219 | |
| 2220 Vbuilt_in_face_specifiers = Flist (n, syms); | |
| 2221 staticpro (&Vbuilt_in_face_specifiers); | |
| 2222 } | |
| 2223 } | |
| 2224 | |
| 2225 void | |
| 2226 complex_vars_of_faces (void) | |
| 2227 { | |
| 2228 /* Create the default face now so we know what it is immediately. */ | |
| 2229 | |
| 2230 Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus | |
| 2231 default value */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2232 Vdefault_face = Fmake_face (Qdefault, build_defer_string ("default face"), |
| 428 | 2233 Qnil); |
| 2234 | |
| 2235 /* Provide some last-resort fallbacks to avoid utter fuckage if | |
| 2236 someone provides invalid values for the global specifications. */ | |
| 2237 | |
| 2238 { | |
| 2239 Lisp_Object fg_fb = Qnil, bg_fb = Qnil; | |
| 2240 | |
| 462 | 2241 #ifdef HAVE_GTK |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2242 fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2243 bg_fb = acons (list1 (Qgtk), build_ascstring ("white"), bg_fb); |
| 462 | 2244 #endif |
| 428 | 2245 #ifdef HAVE_X_WINDOWS |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2246 fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2247 bg_fb = acons (list1 (Qx), build_ascstring ("gray80"), bg_fb); |
| 428 | 2248 #endif |
| 2249 #ifdef HAVE_TTY | |
| 2250 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); | |
| 2251 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); | |
| 2252 #endif | |
| 2253 #ifdef HAVE_MS_WINDOWS | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2254 fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2255 bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2256 fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2257 bg_fb = acons (list1 (Qmswindows), build_ascstring ("white"), bg_fb); |
| 428 | 2258 #endif |
| 2259 set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb); | |
| 2260 set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb); | |
| 2261 } | |
| 2262 | |
| 2263 { | |
| 2264 Lisp_Object inst_list = Qnil; | |
| 462 | 2265 |
| 872 | 2266 #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) |
| 2865 | 2267 |
| 3659 | 2268 #ifdef HAVE_GTK |
| 2269 Lisp_Object device_symbol = Qgtk; | |
| 2270 #else | |
| 2271 Lisp_Object device_symbol = Qx; | |
| 2272 #endif | |
| 2273 | |
|
4827
11daf37dae4d
more fixes to get a clean compile
Ben Wing <ben@xemacs.org>
parents:
4766
diff
changeset
|
2274 #if defined (USE_XFT) || defined (MULE) |
| 3802 | 2275 const Ascbyte **fontptr; |
| 3659 | 2276 |
| 2367 | 2277 const Ascbyte *fonts[] = |
| 428 | 2278 { |
| 3094 | 2279 #ifdef USE_XFT |
| 2280 /************** Xft fonts *************/ | |
| 2281 | |
| 2282 /* Note that fontconfig can search for several font families in one | |
| 2283 call. We should use this facility. */ | |
| 3659 | 2284 "Monospace-12", |
| 3094 | 2285 /* do we need to worry about non-Latin characters for monospace? |
| 4187 | 2286 No, at least in Debian's implementation of Xft. |
| 3094 | 2287 We should recommend that "gothic" and "mincho" aliases be created? */ |
| 3659 | 2288 "Sazanami Mincho-12", |
| 2289 /* Japanese #### add encoding info? */ | |
| 4187 | 2290 /* Arphic for Chinese? */ |
| 2291 /* Korean */ | |
| 3094 | 2292 #else |
| 3659 | 2293 /* The default Japanese fonts installed with XFree86 4.0 use this |
| 2294 point size, and the -misc-fixed fonts (which look really bad with | |
| 2295 Han characters) don't. We need to prefer the former. */ | |
| 2296 "-*-*-medium-r-*-*-*-150-*-*-c-*-*-*", | |
| 2297 /* And the Chinese ones, maddeningly, use this one. (But on 4.0, while | |
| 2298 XListFonts returns them, XLoadQueryFont on the fully-specified XLFD | |
| 2299 corresponding to one of them fails!) */ | |
| 2300 "-*-*-medium-r-*-*-*-160-*-*-c-*-*-*", | |
| 2301 "-*-*-medium-r-*-*-*-170-*-*-c-*-*-*", | |
| 3094 | 2302 #endif |
| 428 | 2303 }; |
|
4827
11daf37dae4d
more fixes to get a clean compile
Ben Wing <ben@xemacs.org>
parents:
4766
diff
changeset
|
2304 #endif /* defined (USE_XFT) || defined (MULE) */ |
| 3802 | 2305 |
| 2306 #ifdef MULE | |
| 428 | 2307 |
| 3659 | 2308 /* Define some specifier tags for classes of character sets. Combining |
| 2309 these allows for distinct fallback fonts for distinct dimensions of | |
| 2310 character sets and stages. */ | |
| 2311 | |
| 2312 define_specifier_tag(Qtwo_dimensional, Qnil, | |
| 2313 intern ("specifier-tag-two-dimensional-p")); | |
| 2314 | |
| 2315 define_specifier_tag(Qone_dimensional, Qnil, | |
| 2316 intern ("specifier-tag-one-dimensional-p")); | |
| 2317 | |
| 4187 | 2318 define_specifier_tag(Qinitial, Qnil, |
| 3659 | 2319 intern ("specifier-tag-initial-stage-p")); |
| 2320 | |
| 4187 | 2321 define_specifier_tag(Qfinal, Qnil, |
| 3659 | 2322 intern ("specifier-tag-final-stage-p")); |
| 2323 | |
| 2324 define_specifier_tag (Qencode_as_utf_8, Qnil, | |
| 2325 intern("specifier-tag-encode-as-utf-8-p")); | |
| 3918 | 2326 |
| 2327 /* This tag is used to group those instantiators made available in the | |
| 2328 fallback for the sake of coverage of obscure characters, notably | |
| 2329 Markus Kuhn's misc-fixed fonts. They will be copied from the fallback | |
| 2330 when the default face is determined from X resources at startup. */ | |
| 2331 define_specifier_tag (Qx_coverage_instantiator, Qnil, Qnil); | |
| 2332 | |
| 3659 | 2333 #endif /* MULE */ |
| 2334 | |
| 3747 | 2335 #ifdef USE_XFT |
| 2336 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) | |
| 2337 inst_list = Fcons (Fcons (list1 (device_symbol), | |
| 2338 build_string (*fontptr)), | |
| 2339 inst_list); | |
| 2340 | |
| 2341 #else /* !USE_XFT */ | |
| 3659 | 2342 inst_list = |
| 4187 | 2343 Fcons |
| 3659 | 2344 (Fcons |
| 4187 | 2345 (list1 (device_symbol), |
|
4766
32b358a240b0
Avoid calling Xft if not built in.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4759
diff
changeset
|
2346 /* grrr. This really does need to be "*", not an XLFD. |
|
32b358a240b0
Avoid calling Xft if not built in.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4759
diff
changeset
|
2347 An unspecified XLFD won't pick up stuff like 10x20. */ |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2348 build_ascstring ("*")), |
| 3659 | 2349 inst_list); |
| 4187 | 2350 #ifdef MULE |
| 3659 | 2351 |
| 2352 /* For Han characters and Ethiopic, we want the misc-fixed font used to | |
| 2353 be distinct from that for alphabetic scripts, because the font | |
| 2354 specified below is distractingly ugly when used for Han characters | |
| 2355 (this is slightly less so) and because its coverage isn't up to | |
| 2356 handling them (well, chiefly, it's not up to handling Ethiopic--we do | |
| 2357 have charset-specific fallbacks for the East Asian charsets.) */ | |
| 4187 | 2358 inst_list = |
| 3659 | 2359 Fcons |
| 2360 (Fcons | |
| 4187 | 2361 (list4(device_symbol, Qtwo_dimensional, Qfinal, Qx_coverage_instantiator), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2362 build_ascstring |
| 3659 | 2363 ("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")), |
| 2364 inst_list); | |
| 2365 | |
| 2366 /* Use Markus Kuhn's version of misc-fixed as the font for the font for | |
| 2367 when a given charset's registries can't be found and redisplay for | |
| 2368 that charset falls back to iso10646-1. */ | |
| 428 | 2369 |
| 4187 | 2370 inst_list = |
| 3659 | 2371 Fcons |
| 2372 (Fcons | |
| 4187 | 2373 (list4(device_symbol, Qone_dimensional, Qfinal, Qx_coverage_instantiator), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2374 build_ascstring |
| 4187 | 2375 ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), |
| 3659 | 2376 inst_list); |
| 2377 | |
| 462 | 2378 for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) |
| 4187 | 2379 inst_list = Fcons (Fcons (list3 (device_symbol, |
| 3659 | 2380 Qtwo_dimensional, Qinitial), |
| 2381 build_string (*fontptr)), | |
| 462 | 2382 inst_list); |
| 3659 | 2383 |
| 2384 /* We need to set the font for the JIT-ucs-charsets separately from the | |
| 2385 final stage, since otherwise it picks up the two-dimensional | |
| 2386 specification (see specifier-tag-two-dimensional-initial-stage-p | |
| 2387 above). They also use Markus Kuhn's ISO 10646-1 fixed fonts for | |
| 2388 redisplay. */ | |
| 2389 | |
| 4187 | 2390 inst_list = |
| 3659 | 2391 Fcons |
| 2392 (Fcons | |
| 4187 | 2393 (list4(device_symbol, Qencode_as_utf_8, Qinitial, Qx_coverage_instantiator), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2394 build_ascstring |
| 4187 | 2395 ("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")), |
| 3659 | 2396 inst_list); |
| 2397 | |
| 2398 #endif /* MULE */ | |
| 2399 | |
| 2400 /* Needed to make sure that charsets with non-specified fonts don't | |
| 2401 use bold and oblique first if medium and regular are available. */ | |
| 2402 inst_list = | |
| 4187 | 2403 Fcons |
| 3659 | 2404 (Fcons |
| 4187 | 2405 (list1 (device_symbol), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2406 build_ascstring ("-*-*-medium-r-*-*-*-120-*-*-c-*-*-*")), |
| 3659 | 2407 inst_list); |
| 2408 | |
| 2409 /* With a Cygwin XFree86 install, this returns the best (clearest, | |
| 2410 most readable) font I can find when scaling of bitmap fonts is | |
| 2411 turned on, as it is by default. (WHO IN THE NAME OF CHRIST THOUGHT | |
| 2412 THAT WAS A GOOD IDEA?!?!) The other fonts that used to be specified | |
| 2413 here gave horrendous results. */ | |
| 2414 | |
| 2415 inst_list = | |
| 4187 | 2416 Fcons |
| 3659 | 2417 (Fcons |
| 4187 | 2418 (list1 (device_symbol), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2419 build_ascstring ("-*-lucidatypewriter-medium-r-*-*-*-120-*-*-*-*-*-*")), |
| 3659 | 2420 inst_list); |
| 2421 | |
| 3747 | 2422 #endif /* !USE_XFT */ |
| 2423 | |
| 462 | 2424 #endif /* HAVE_X_WINDOWS || HAVE_GTK */ |
| 2425 | |
| 428 | 2426 #ifdef HAVE_TTY |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2427 inst_list = Fcons (Fcons (list1 (Qtty), build_ascstring ("normal")), |
| 428 | 2428 inst_list); |
| 2429 #endif /* HAVE_TTY */ | |
| 440 | 2430 |
| 771 | 2431 #ifdef HAVE_MS_WINDOWS |
| 2432 { | |
| 2367 | 2433 const Ascbyte *mswfonts[] = |
| 4187 | 2434 { |
| 2435 "Courier New:Regular:10::", | |
| 2436 "Courier:Regular:10::", | |
| 2437 ":Regular:10::" | |
| 2438 }; | |
| 2367 | 2439 const Ascbyte **mswfontptr; |
| 2865 | 2440 |
| 771 | 2441 for (mswfontptr = mswfonts + countof (mswfonts) - 1; |
| 2442 mswfontptr >= mswfonts; mswfontptr--) | |
| 4187 | 2443 { |
| 2444 /* display device */ | |
| 2445 inst_list = Fcons (Fcons (list1 (Qmswindows), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2446 build_ascstring (*mswfontptr)), |
| 4187 | 2447 inst_list); |
| 2448 /* printer device */ | |
| 2449 inst_list = Fcons (Fcons (list1 (Qmsprinter), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2450 build_ascstring (*mswfontptr)), |
| 4187 | 2451 inst_list); |
| 2452 } | |
| 793 | 2453 /* Use Lucida Console rather than Courier New if it exists -- the |
| 4187 | 2454 line spacing is much less, so many more lines fit with the same |
| 2455 size font. (And it's specifically designed for screens.) */ | |
| 2865 | 2456 inst_list = Fcons (Fcons (list1 (Qmswindows), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2457 build_ascstring ("Lucida Console:Regular:10::")), |
| 793 | 2458 inst_list); |
| 771 | 2459 } |
| 428 | 2460 #endif /* HAVE_MS_WINDOWS */ |
| 771 | 2461 |
| 428 | 2462 set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list); |
| 2463 } | |
| 2464 | |
| 2465 set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil), | |
| 2466 list1 (Fcons (Qnil, Qnil))); | |
| 2467 set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil), | |
| 2468 list1 (Fcons (Qnil, Qnil))); | |
| 2469 set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil), | |
| 2470 list1 (Fcons (Qnil, Qnil))); | |
| 2471 set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil), | |
| 2472 list1 (Fcons (Qnil, Qnil))); | |
| 2473 set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil), | |
| 2474 list1 (Fcons (Qnil, Qnil))); | |
| 2475 set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil), | |
| 2476 list1 (Fcons (Qnil, Qnil))); | |
| 2477 | |
| 2478 /* gui-element is the parent face of all gui elements such as | |
| 2479 modeline, vertical divider and toolbar. */ | |
| 2480 Vgui_element_face = Fmake_face (Qgui_element, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2481 build_defer_string ("gui element face"), |
| 428 | 2482 Qnil); |
| 2483 | |
| 2484 /* Provide some last-resort fallbacks for gui-element face which | |
| 2485 mustn't default to default. */ | |
| 2486 { | |
| 2487 Lisp_Object fg_fb = Qnil, bg_fb = Qnil; | |
| 2488 | |
| 3094 | 2489 /* #### gui-element face doesn't have a font property? |
| 2490 But it gets referred to later! */ | |
| 462 | 2491 #ifdef HAVE_GTK |
| 2492 /* We need to put something in there, or error checking gets | |
| 2493 #%!@#ed up before the styles are set, which override the | |
| 2494 fallbacks. */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2495 fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2496 bg_fb = acons (list1 (Qgtk), build_ascstring ("Gray80"), bg_fb); |
| 462 | 2497 #endif |
| 428 | 2498 #ifdef HAVE_X_WINDOWS |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2499 fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2500 bg_fb = acons (list1 (Qx), build_ascstring ("Gray80"), bg_fb); |
| 428 | 2501 #endif |
| 2502 #ifdef HAVE_TTY | |
| 2503 fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); | |
| 2504 bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); | |
| 2505 #endif | |
| 2506 #ifdef HAVE_MS_WINDOWS | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2507 fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2508 bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2509 fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2510 bg_fb = acons (list1 (Qmswindows), build_ascstring ("Gray75"), bg_fb); |
| 428 | 2511 #endif |
| 2512 set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb); | |
| 2513 set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb); | |
| 2514 } | |
| 2515 | |
| 2516 /* Now create the other faces that redisplay needs to refer to | |
| 2517 directly. We could create them in Lisp but it's simpler this | |
| 2518 way since we need to get them anyway. */ | |
| 2519 | |
| 2520 /* modeline is gui element. */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2521 Vmodeline_face = Fmake_face (Qmodeline, build_defer_string ("modeline face"), |
| 428 | 2522 Qnil); |
| 2523 | |
| 2524 set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound), | |
| 2525 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
| 2526 set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound), | |
| 2527 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
| 2528 set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil), | |
| 2529 Fget (Vgui_element_face, Qbackground_pixmap, | |
| 2530 Qunbound)); | |
| 2531 | |
| 2532 /* toolbar is another gui element */ | |
| 2533 Vtoolbar_face = Fmake_face (Qtoolbar, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2534 build_defer_string ("toolbar face"), |
| 428 | 2535 Qnil); |
| 2536 set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound), | |
| 2537 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
| 2538 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound), | |
| 2539 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
| 2540 set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil), | |
| 2541 Fget (Vgui_element_face, Qbackground_pixmap, | |
| 2542 Qunbound)); | |
| 2543 | |
| 2544 /* vertical divider is another gui element */ | |
| 2545 Vvertical_divider_face = Fmake_face (Qvertical_divider, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2546 build_defer_string ("vertical divider face"), |
| 428 | 2547 Qnil); |
| 2548 | |
| 2549 set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound), | |
| 2550 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
| 2551 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound), | |
| 2552 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
| 2553 set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap, | |
| 2554 Qunbound), | |
| 2555 Fget (Vgui_element_face, Qbackground_pixmap, | |
| 2556 Qunbound)); | |
| 2557 | |
| 2558 /* widget is another gui element */ | |
| 2559 Vwidget_face = Fmake_face (Qwidget, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2560 build_defer_string ("widget face"), |
| 428 | 2561 Qnil); |
| 3094 | 2562 /* #### weird ... the gui-element face doesn't have its own font yet */ |
| 442 | 2563 set_specifier_fallback (Fget (Vwidget_face, Qfont, Qunbound), |
| 2564 Fget (Vgui_element_face, Qfont, Qunbound)); | |
| 428 | 2565 set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound), |
| 2566 Fget (Vgui_element_face, Qforeground, Qunbound)); | |
| 2567 set_specifier_fallback (Fget (Vwidget_face, Qbackground, Qunbound), | |
| 2568 Fget (Vgui_element_face, Qbackground, Qunbound)); | |
| 442 | 2569 /* We don't want widgets to have a default background pixmap. */ |
| 428 | 2570 |
| 2571 Vleft_margin_face = Fmake_face (Qleft_margin, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2572 build_defer_string ("left margin face"), |
| 428 | 2573 Qnil); |
| 2574 Vright_margin_face = Fmake_face (Qright_margin, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2575 build_defer_string ("right margin face"), |
| 428 | 2576 Qnil); |
| 2577 Vtext_cursor_face = Fmake_face (Qtext_cursor, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2578 build_defer_string ("face for text cursor"), |
| 428 | 2579 Qnil); |
| 2580 Vpointer_face = | |
| 2581 Fmake_face (Qpointer, | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4862
diff
changeset
|
2582 build_defer_string |
| 428 | 2583 ("face for foreground/background colors of mouse pointer"), |
| 2584 Qnil); | |
| 2585 } |