Mercurial > hg > xemacs-beta
annotate src/objects.c @ 4976:16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-04 Ben Wing <ben@xemacs.org>
* alloc.c (release_breathing_space):
* alloc.c (resize_string):
* alloc.c (sweep_lcrecords_1):
* alloc.c (SWEEP_FIXED_TYPE_BLOCK_1):
* alloc.c (ADDITIONAL_FREE_compiled_function):
* alloc.c (compact_string_chars):
* alloc.c (ADDITIONAL_FREE_string):
* alloc.c (sweep_strings):
* alloca.c (xemacs_c_alloca):
* alsaplay.c (alsa_play_sound_file):
* buffer.c (init_initial_directory):
* buffer.h:
* buffer.h (BUFFER_FREE):
* console-stream.c (stream_delete_console):
* console-tty.c (free_tty_console_struct):
* data.c (Fnumber_to_string):
* device-gtk.c (gtk_init_device):
* device-gtk.c (free_gtk_device_struct):
* device-gtk.c (gtk_delete_device):
* device-msw.c (mswindows_delete_device):
* device-msw.c (msprinter_delete_device):
* device-tty.c (free_tty_device_struct):
* device-tty.c (tty_delete_device):
* device-x.c (x_init_device):
* device-x.c (free_x_device_struct):
* device-x.c (x_delete_device):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* dired-msw.c (Fmswindows_insert_directory):
* dired.c (free_user_cache):
* dired.c (user_name_completion_unwind):
* doc.c (unparesseuxify_doc_string):
* doc.c (Fsubstitute_command_keys):
* doprnt.c (emacs_doprnt_1):
* dumper.c (pdump_load_finish):
* dumper.c (pdump_file_free):
* dumper.c (pdump_file_unmap):
* dynarr.c:
* dynarr.c (Dynarr_free):
* editfns.c (uncache_home_directory):
* editfns.c (Fset_time_zone_rule):
* elhash.c:
* elhash.c (pdump_reorganize_hash_table):
* elhash.c (maphash_unwind):
* emacs.c (make_arg_list_1):
* emacs.c (free_argc_argv):
* emacs.c (sort_args):
* emacs.c (Frunning_temacs_p):
* emodules.c (attempt_module_delete):
* eval.c (free_pointer):
* event-Xt.c (unselect_filedesc):
* event-Xt.c (emacs_Xt_select_process):
* event-gtk.c (unselect_filedesc):
* event-gtk.c (dragndrop_data_received):
* event-msw.c (winsock_closer):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* event-stream.c (finalize_command_builder):
* event-stream.c (free_command_builder):
* extents.c (free_gap_array):
* extents.c (free_extent_list):
* extents.c (free_soe):
* extents.c (extent_fragment_delete):
* extents.c (extent_priority_sort_function):
* file-coding.c (make_coding_system_1):
* file-coding.c (coding_finalizer):
* file-coding.c (set_coding_stream_coding_system):
* file-coding.c (chain_finalize_coding_stream_1):
* file-coding.c (chain_finalize):
* file-coding.c (free_detection_state):
* file-coding.c (coding_category_symbol_to_id):
* fileio.c:
* fileio.c (Ffile_name_directory):
* fileio.c (if):
* fileio.c (Ffile_symlink_p):
* filelock.c (FREE_LOCK_INFO):
* filelock.c (current_lock_owner):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* frame-gtk.c (gtk_delete_frame):
* frame-msw.c (mswindows_delete_frame):
* frame-msw.c (msprinter_delete_frame):
* frame-x.c (x_cde_destroy_callback):
* frame-x.c (Fcde_start_drag_internal):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_delete_frame):
* frame.c (update_frame_title):
* frame.c (Fset_frame_pointer):
* gc.c (register_for_finalization):
* gccache-gtk.c (free_gc_cache):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c (free_gc_cache):
* gccache-x.c (gc_cache_lookup):
* glyphs-eimage.c:
* glyphs-eimage.c (jpeg_instantiate_unwind):
* glyphs-eimage.c (gif_instantiate_unwind):
* glyphs-eimage.c (png_instantiate_unwind):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate_unwind):
* glyphs-gtk.c (convert_EImage_to_GDKImage):
* glyphs-gtk.c (gtk_finalize_image_instance):
* glyphs-gtk.c (gtk_init_image_instance_from_eimage):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-msw.c (convert_EImage_to_DIBitmap):
* glyphs-msw.c (mswindows_init_image_instance_from_eimage):
* glyphs-msw.c (mswindows_initialize_image_instance_mask):
* glyphs-msw.c (xpm_to_eimage):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (xbm_create_bitmap_from_data):
* glyphs-msw.c (mswindows_finalize_image_instance):
* glyphs-x.c (convert_EImage_to_XImage):
* glyphs-x.c (x_finalize_image_instance):
* glyphs-x.c (x_init_image_instance_from_eimage):
* glyphs-x.c (x_xpm_instantiate):
* gui-x.c (free_popup_widget_value_tree):
* hash.c (free_hash_table):
* hash.c (grow_hash_table):
* hash.c (pregrow_hash_table_if_necessary):
* imgproc.c (build_EImage_quantable):
* insdel.c (uninit_buffer_text):
* intl-win32.c (convert_multibyte_to_internal_malloc):
* intl.c:
* intl.c (Fset_current_locale):
* keymap.c:
* keymap.c (where_is_recursive_mapper):
* keymap.c (where_is_internal):
* lisp.h:
* lisp.h (xfree):
* lstream.c (Lstream_close):
* lstream.c (resizing_buffer_closer):
* mule-coding.c:
* mule-coding.c (iso2022_finalize_detection_state):
* nt.c:
* nt.c (mswindows_get_long_filename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_opendir):
* nt.c (mswindows_closedir):
* nt.c (mswindows_readdir):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (Fmswindows_long_file_name):
* ntplay.c (nt_play_sound_file):
* ntplay.c (play_sound_data_1):
* number-gmp.c (gmp_free):
* number-gmp.c (init_number_gmp):
* number-mp.c (bignum_to_string):
* number-mp.c (BIGNUM_TO_TYPE):
* number.c (bignum_print):
* number.c (bignum_convfree):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-gtk.c (gtk_finalize_color_instance):
* objects-gtk.c (gtk_finalize_font_instance):
* objects-msw.c (mswindows_finalize_color_instance):
* objects-msw.c (mswindows_finalize_font_instance):
* objects-tty.c (tty_finalize_color_instance):
* objects-tty.c (tty_finalize_font_instance):
* objects-tty.c (tty_font_list):
* objects-x.c (x_finalize_color_instance):
* objects-x.c (x_finalize_font_instance):
* process.c:
* process.c (finalize_process):
* realpath.c:
* redisplay.c (add_propagation_runes):
* regex.c:
* regex.c (xfree):
* regex.c (REGEX_FREE_STACK):
* regex.c (FREE_STACK_RETURN):
* regex.c (regex_compile):
* regex.c (regexec):
* regex.c (regfree):
* scrollbar-gtk.c (gtk_free_scrollbar_instance):
* scrollbar-gtk.c (gtk_release_scrollbar_instance):
* scrollbar-msw.c (mswindows_free_scrollbar_instance):
* scrollbar-msw.c (unshow_that_mofo):
* scrollbar-x.c (x_free_scrollbar_instance):
* scrollbar-x.c (x_release_scrollbar_instance):
* select-gtk.c (emacs_gtk_selection_handle):
* select-msw.c (mswindows_own_selection):
* select-x.c:
* select-x.c (x_handle_selection_request):
* select-x.c (unexpect_property_change):
* select-x.c (x_handle_property_notify):
* select-x.c (receive_incremental_selection):
* select-x.c (x_get_window_property_as_lisp_data):
* select-x.c (Fx_get_cutbuffer_internal):
* specifier.c (finalize_specifier):
* syntax.c (uninit_buffer_syntax_cache):
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_lstat):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_ctime):
* sysdep.c (closedir):
* sysdep.c (DIRSIZ):
* termcap.c (tgetent):
* termcap.c (tprint):
* tests.c (Ftest_data_format_conversion):
* text.c (new_dfc_convert_copy_data):
* text.h (eifree):
* text.h (eito_alloca):
* text.h (eito_external):
* toolbar-msw.c (mswindows_output_toolbar):
* ui-gtk.c (CONVERT_RETVAL):
* ui-gtk.c (__allocate_object_storage):
* unicode.c (free_from_unicode_table):
* unicode.c (free_to_unicode_table):
* unicode.c (free_charset_unicode_tables):
* win32.c (mswindows_read_link_1):
Rename: xfree(VAL, TYPE)->xfree(VAL)
Command used:
gr 'xfree *\((.*),.*\);' 'xfree (\1);' *.[ch]
Followed by grepping for 'xfree.*,' and fixing anything left.
Rationale: Having to specify the TYPE argument is annoying and
error-prone. It was originally put in to work around warnings
due to strict aliasing but years and years ago I rewrote it
in a way that doesn't use the TYPE argument at all and no one
has complained since then. (And anyway, XEmacs is far from
ever being in compliance with strict aliasing and would require
far-reaching changes to get that way.)
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Thu, 04 Feb 2010 07:28:14 -0600 |
| parents | 6ef8256a020a |
| children | d95c102a96d3 |
| rev | line source |
|---|---|
| 428 | 1 /* Generic Objects and Functions. |
| 2 Copyright (C) 1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 2527 | 4 Copyright (C) 1995, 1996, 2002, 2004 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 25 #include <config.h> | |
| 26 #include "lisp.h" | |
| 27 | |
| 771 | 28 #include "buffer.h" |
| 872 | 29 #include "device-impl.h" |
| 428 | 30 #include "elhash.h" |
| 31 #include "faces.h" | |
| 32 #include "frame.h" | |
| 800 | 33 #include "glyphs.h" |
| 872 | 34 #include "objects-impl.h" |
| 428 | 35 #include "specifier.h" |
| 36 #include "window.h" | |
| 37 | |
| 1204 | 38 #ifdef HAVE_TTY |
| 39 #include "console-tty.h" | |
| 40 #endif | |
| 934 | 41 |
| 428 | 42 /* Objects that are substituted when an instantiation fails. |
| 43 If we leave in the Qunbound value, we will probably get crashes. */ | |
| 44 Lisp_Object Vthe_null_color_instance, Vthe_null_font_instance; | |
| 45 | |
| 46 /* Authors: Ben Wing, Chuck Thompson */ | |
| 47 | |
| 2268 | 48 DOESNT_RETURN |
| 428 | 49 finalose (void *ptr) |
| 50 { | |
| 793 | 51 Lisp_Object obj = wrap_pointer_1 (ptr); |
| 52 | |
| 563 | 53 invalid_operation |
| 428 | 54 ("Can't dump an emacs containing window system objects", obj); |
| 55 } | |
| 56 | |
| 57 | |
| 58 /**************************************************************************** | |
| 59 * Color-Instance Object * | |
| 60 ****************************************************************************/ | |
| 61 | |
| 62 Lisp_Object Qcolor_instancep; | |
| 63 | |
| 1204 | 64 static const struct memory_description color_instance_data_description_1 []= { |
| 65 #ifdef HAVE_TTY | |
| 3092 | 66 #ifdef NEW_GC |
| 67 { XD_LISP_OBJECT, tty_console }, | |
| 68 #else /* not NEW_GC */ | |
| 2551 | 69 { XD_BLOCK_PTR, tty_console, 1, { &tty_color_instance_data_description } }, |
| 3092 | 70 #endif /* not NEW_GC */ |
| 1204 | 71 #endif |
| 934 | 72 { XD_END } |
| 73 }; | |
| 74 | |
| 1204 | 75 static const struct sized_memory_description color_instance_data_description = { |
| 76 sizeof (void *), color_instance_data_description_1 | |
| 934 | 77 }; |
| 78 | |
| 1204 | 79 static const struct memory_description color_instance_description[] = { |
| 934 | 80 { XD_INT, offsetof (Lisp_Color_Instance, color_instance_type) }, |
| 81 { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, name)}, | |
| 82 { XD_LISP_OBJECT, offsetof (Lisp_Color_Instance, device)}, | |
| 1204 | 83 { XD_UNION, offsetof (Lisp_Color_Instance, data), |
| 2551 | 84 XD_INDIRECT (0, 0), { &color_instance_data_description } }, |
| 934 | 85 {XD_END} |
| 86 }; | |
| 87 | |
| 428 | 88 static Lisp_Object |
| 89 mark_color_instance (Lisp_Object obj) | |
| 90 { | |
| 440 | 91 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); |
| 428 | 92 mark_object (c->name); |
| 93 if (!NILP (c->device)) /* Vthe_null_color_instance */ | |
| 94 MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c)); | |
| 95 | |
| 96 return c->device; | |
| 97 } | |
| 98 | |
| 99 static void | |
| 100 print_color_instance (Lisp_Object obj, Lisp_Object printcharfun, | |
| 101 int escapeflag) | |
| 102 { | |
| 440 | 103 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); |
| 428 | 104 if (print_readably) |
| 4846 | 105 printing_unreadable_lcrecord (obj, 0); |
| 800 | 106 write_fmt_string_lisp (printcharfun, "#<color-instance %s", 1, c->name); |
| 107 write_fmt_string_lisp (printcharfun, " on %s", 1, c->device); | |
| 428 | 108 if (!NILP (c->device)) /* Vthe_null_color_instance */ |
| 109 MAYBE_DEVMETH (XDEVICE (c->device), print_color_instance, | |
| 110 (c, printcharfun, escapeflag)); | |
| 800 | 111 write_fmt_string (printcharfun, " 0x%x>", c->header.uid); |
| 428 | 112 } |
| 113 | |
| 114 static void | |
| 115 finalize_color_instance (void *header, int for_disksave) | |
| 116 { | |
| 440 | 117 Lisp_Color_Instance *c = (Lisp_Color_Instance *) header; |
| 428 | 118 |
| 119 if (!NILP (c->device)) | |
| 120 { | |
| 121 if (for_disksave) finalose (c); | |
| 122 MAYBE_DEVMETH (XDEVICE (c->device), finalize_color_instance, (c)); | |
| 123 } | |
| 124 } | |
| 125 | |
| 126 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
127 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
128 int UNUSED (foldcase)) |
| 428 | 129 { |
| 440 | 130 Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1); |
| 131 Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2); | |
| 428 | 132 |
| 133 return (c1 == c2) || | |
| 134 (EQ (c1->device, c2->device) && | |
| 135 DEVICEP (c1->device) && | |
| 136 HAS_DEVMETH_P (XDEVICE (c1->device), color_instance_equal) && | |
| 137 DEVMETH (XDEVICE (c1->device), color_instance_equal, (c1, c2, depth))); | |
| 138 } | |
| 139 | |
| 2515 | 140 static Hashcode |
| 428 | 141 color_instance_hash (Lisp_Object obj, int depth) |
| 142 { | |
| 440 | 143 Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj); |
| 428 | 144 struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0; |
| 145 | |
| 2515 | 146 return HASH2 ((Hashcode) d, |
| 428 | 147 !d ? LISP_HASH (obj) |
| 148 : DEVMETH_OR_GIVEN (d, color_instance_hash, (c, depth), | |
| 149 LISP_HASH (obj))); | |
| 150 } | |
| 151 | |
| 934 | 152 DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance, |
| 153 0, /*dumpable-flag*/ | |
| 154 mark_color_instance, print_color_instance, | |
| 155 finalize_color_instance, color_instance_equal, | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
156 color_instance_hash, |
| 934 | 157 color_instance_description, |
| 158 Lisp_Color_Instance); | |
| 428 | 159 |
| 160 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /* | |
| 161 Return a new `color-instance' object named NAME (a string). | |
| 162 | |
| 163 Optional argument DEVICE specifies the device this object applies to | |
| 164 and defaults to the selected device. | |
| 165 | |
| 166 An error is signaled if the color is unknown or cannot be allocated; | |
| 444 | 167 however, if optional argument NOERROR is non-nil, nil is simply |
| 168 returned in this case. (And if NOERROR is other than t, a warning may | |
| 428 | 169 be issued.) |
| 170 | |
| 171 The returned object is a normal, first-class lisp object. The way you | |
| 172 `deallocate' the color is the way you deallocate any other lisp object: | |
| 173 you drop all pointers to it and allow it to be garbage collected. When | |
| 174 these objects are GCed, the underlying window-system data (e.g. X object) | |
| 175 is deallocated as well. | |
| 176 */ | |
| 444 | 177 (name, device, noerror)) |
| 428 | 178 { |
| 440 | 179 Lisp_Color_Instance *c; |
| 428 | 180 int retval; |
| 181 | |
| 182 CHECK_STRING (name); | |
| 793 | 183 device = wrap_device (decode_device (device)); |
| 428 | 184 |
| 3017 | 185 c = ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); |
| 428 | 186 c->name = name; |
| 187 c->device = device; | |
| 188 c->data = 0; | |
| 1204 | 189 c->color_instance_type = get_console_variant (XDEVICE_TYPE (c->device)); |
| 428 | 190 |
| 191 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance, | |
| 192 (c, name, device, | |
| 444 | 193 decode_error_behavior_flag (noerror))); |
| 428 | 194 if (!retval) |
| 195 return Qnil; | |
| 196 | |
| 793 | 197 return wrap_color_instance (c); |
| 428 | 198 } |
| 199 | |
| 200 DEFUN ("color-instance-p", Fcolor_instance_p, 1, 1, 0, /* | |
| 201 Return non-nil if OBJECT is a color instance. | |
| 202 */ | |
| 203 (object)) | |
| 204 { | |
| 205 return COLOR_INSTANCEP (object) ? Qt : Qnil; | |
| 206 } | |
| 207 | |
| 208 DEFUN ("color-instance-name", Fcolor_instance_name, 1, 1, 0, /* | |
| 209 Return the name used to allocate COLOR-INSTANCE. | |
| 210 */ | |
| 211 (color_instance)) | |
| 212 { | |
| 213 CHECK_COLOR_INSTANCE (color_instance); | |
| 214 return XCOLOR_INSTANCE (color_instance)->name; | |
| 215 } | |
| 216 | |
| 217 DEFUN ("color-instance-rgb-components", Fcolor_instance_rgb_components, 1, 1, 0, /* | |
| 218 Return a three element list containing the red, green, and blue | |
| 219 color components of COLOR-INSTANCE, or nil if unknown. | |
| 220 Component values range from 0 to 65535. | |
| 221 */ | |
| 222 (color_instance)) | |
| 223 { | |
| 440 | 224 Lisp_Color_Instance *c; |
| 428 | 225 |
| 226 CHECK_COLOR_INSTANCE (color_instance); | |
| 227 c = XCOLOR_INSTANCE (color_instance); | |
| 228 | |
| 229 if (NILP (c->device)) | |
| 230 return Qnil; | |
| 231 | |
| 232 return MAYBE_LISP_DEVMETH (XDEVICE (c->device), | |
| 233 color_instance_rgb_components, | |
| 234 (c)); | |
| 235 } | |
| 236 | |
| 237 DEFUN ("valid-color-name-p", Fvalid_color_name_p, 1, 2, 0, /* | |
| 238 Return true if COLOR names a valid color for the current device. | |
| 239 | |
| 240 Valid color names for X are listed in the file /usr/lib/X11/rgb.txt, or | |
| 241 whatever the equivalent is on your system. | |
| 242 | |
| 243 Valid color names for TTY are those which have an ISO 6429 (ANSI) sequence. | |
| 244 In addition to being a color this may be one of a number of attributes | |
| 245 such as `blink'. | |
| 246 */ | |
| 247 (color, device)) | |
| 248 { | |
| 249 struct device *d = decode_device (device); | |
| 250 | |
| 251 CHECK_STRING (color); | |
| 252 return MAYBE_INT_DEVMETH (d, valid_color_name_p, (d, color)) ? Qt : Qnil; | |
| 253 } | |
| 254 | |
| 2527 | 255 DEFUN ("color-list", Fcolor_list, 0, 1, 0, /* |
| 256 Return a list of color names. | |
| 257 DEVICE specifies which device to return names for, and defaults to the | |
| 258 currently selected device. | |
| 259 */ | |
| 260 (device)) | |
| 261 { | |
| 262 device = wrap_device (decode_device (device)); | |
| 263 | |
| 264 return MAYBE_LISP_DEVMETH (XDEVICE (device), color_list, ()); | |
| 265 } | |
| 266 | |
| 428 | 267 |
| 268 /*************************************************************************** | |
| 269 * Font-Instance Object * | |
| 270 ***************************************************************************/ | |
| 271 | |
| 272 Lisp_Object Qfont_instancep; | |
| 273 | |
| 274 static Lisp_Object font_instance_truename_internal (Lisp_Object xfont, | |
| 578 | 275 Error_Behavior errb); |
| 934 | 276 |
| 1204 | 277 static const struct memory_description font_instance_data_description_1 []= { |
| 278 #ifdef HAVE_TTY | |
| 3092 | 279 #ifdef NEW_GC |
| 280 { XD_LISP_OBJECT, tty_console }, | |
| 281 #else /* not NEW_GC */ | |
| 282 { XD_BLOCK_PTR, tty_console, 1, { &tty_font_instance_data_description } }, | |
| 283 #endif /* not NEW_GC */ | |
| 1204 | 284 #endif |
| 934 | 285 { XD_END } |
| 286 }; | |
| 287 | |
| 1204 | 288 static const struct sized_memory_description font_instance_data_description = { |
| 289 sizeof (void *), font_instance_data_description_1 | |
| 934 | 290 }; |
| 291 | |
| 1204 | 292 static const struct memory_description font_instance_description[] = { |
| 934 | 293 { XD_INT, offsetof (Lisp_Font_Instance, font_instance_type) }, |
| 294 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, name)}, | |
| 295 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, truename)}, | |
| 296 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, device)}, | |
| 3094 | 297 { XD_LISP_OBJECT, offsetof (Lisp_Font_Instance, charset)}, |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
298 { XD_UNION, offsetof (Lisp_Font_Instance, data), |
| 2551 | 299 XD_INDIRECT (0, 0), { &font_instance_data_description } }, |
| 1204 | 300 { XD_END } |
| 934 | 301 }; |
| 302 | |
| 428 | 303 |
| 304 static Lisp_Object | |
| 305 mark_font_instance (Lisp_Object obj) | |
| 306 { | |
| 440 | 307 Lisp_Font_Instance *f = XFONT_INSTANCE (obj); |
| 428 | 308 |
| 309 mark_object (f->name); | |
| 872 | 310 mark_object (f->truename); |
| 428 | 311 if (!NILP (f->device)) /* Vthe_null_font_instance */ |
| 312 MAYBE_DEVMETH (XDEVICE (f->device), mark_font_instance, (f)); | |
| 313 | |
| 314 return f->device; | |
| 315 } | |
| 316 | |
| 317 static void | |
| 318 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | |
| 319 { | |
| 440 | 320 Lisp_Font_Instance *f = XFONT_INSTANCE (obj); |
| 428 | 321 if (print_readably) |
| 4846 | 322 printing_unreadable_lcrecord (obj, 0); |
| 800 | 323 write_fmt_string_lisp (printcharfun, "#<font-instance %S", 1, f->name); |
| 324 write_fmt_string_lisp (printcharfun, " on %s", 1, f->device); | |
| 428 | 325 if (!NILP (f->device)) |
| 3659 | 326 { |
| 327 MAYBE_DEVMETH (XDEVICE (f->device), print_font_instance, | |
| 328 (f, printcharfun, escapeflag)); | |
| 329 | |
| 330 } | |
| 800 | 331 write_fmt_string (printcharfun, " 0x%x>", f->header.uid); |
| 428 | 332 } |
| 333 | |
| 334 static void | |
| 335 finalize_font_instance (void *header, int for_disksave) | |
| 336 { | |
| 440 | 337 Lisp_Font_Instance *f = (Lisp_Font_Instance *) header; |
| 428 | 338 |
| 339 if (!NILP (f->device)) | |
| 340 { | |
| 341 if (for_disksave) finalose (f); | |
| 342 MAYBE_DEVMETH (XDEVICE (f->device), finalize_font_instance, (f)); | |
| 343 } | |
| 344 } | |
| 345 | |
| 346 /* Fonts are equal if they resolve to the same name. | |
| 347 Since we call `font-truename' to do this, and since font-truename is lazy, | |
| 348 this means the `equal' could cause XListFonts to be run the first time. | |
| 349 */ | |
| 350 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
351 font_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
352 int UNUSED (foldcase)) |
| 428 | 353 { |
| 354 /* #### should this be moved into a device method? */ | |
| 793 | 355 return internal_equal (font_instance_truename_internal |
| 356 (obj1, ERROR_ME_DEBUG_WARN), | |
| 357 font_instance_truename_internal | |
| 358 (obj2, ERROR_ME_DEBUG_WARN), | |
| 428 | 359 depth + 1); |
| 360 } | |
| 361 | |
| 2515 | 362 static Hashcode |
| 428 | 363 font_instance_hash (Lisp_Object obj, int depth) |
| 364 { | |
| 793 | 365 return internal_hash (font_instance_truename_internal |
| 366 (obj, ERROR_ME_DEBUG_WARN), | |
| 428 | 367 depth + 1); |
| 368 } | |
| 369 | |
| 934 | 370 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance, |
| 371 0, /*dumpable-flag*/ | |
| 372 mark_font_instance, print_font_instance, | |
| 373 finalize_font_instance, font_instance_equal, | |
| 1204 | 374 font_instance_hash, font_instance_description, |
| 375 Lisp_Font_Instance); | |
| 934 | 376 |
| 428 | 377 |
| 3094 | 378 /* #### Why is this exposed to Lisp? Used in: |
| 379 x-frob-font-size, gtk-font-menu-load-font, x-font-menu-load-font-xft, | |
| 380 x-font-menu-load-font-core, mswindows-font-menu-load-font, | |
| 381 mswindows-frob-font-style-and-sizify, mswindows-frob-font-size. */ | |
| 382 DEFUN ("make-font-instance", Fmake_font_instance, 1, 4, 0, /* | |
| 428 | 383 Return a new `font-instance' object named NAME. |
| 384 DEVICE specifies the device this object applies to and defaults to the | |
| 385 selected device. An error is signalled if the font is unknown or cannot | |
| 386 be allocated; however, if NOERROR is non-nil, nil is simply returned in | |
| 3094 | 387 this case. CHARSET is used internally. #### make helper function? |
| 428 | 388 |
| 389 The returned object is a normal, first-class lisp object. The way you | |
| 390 `deallocate' the font is the way you deallocate any other lisp object: | |
| 391 you drop all pointers to it and allow it to be garbage collected. When | |
| 3094 | 392 these objects are GCed, the underlying GUI data is deallocated as well. |
| 428 | 393 */ |
| 3094 | 394 (name, device, noerror, charset)) |
| 428 | 395 { |
| 440 | 396 Lisp_Font_Instance *f; |
| 428 | 397 int retval = 0; |
| 578 | 398 Error_Behavior errb = decode_error_behavior_flag (noerror); |
| 428 | 399 |
| 400 if (ERRB_EQ (errb, ERROR_ME)) | |
| 401 CHECK_STRING (name); | |
| 402 else if (!STRINGP (name)) | |
| 403 return Qnil; | |
| 404 | |
| 793 | 405 device = wrap_device (decode_device (device)); |
| 428 | 406 |
| 3017 | 407 f = ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); |
| 428 | 408 f->name = name; |
| 872 | 409 f->truename = Qnil; |
| 428 | 410 f->device = device; |
| 411 | |
| 412 f->data = 0; | |
| 1204 | 413 f->font_instance_type = get_console_variant (XDEVICE_TYPE (f->device)); |
| 428 | 414 |
| 415 /* Stick some default values here ... */ | |
| 416 f->ascent = f->height = 1; | |
| 417 f->descent = 0; | |
| 418 f->width = 1; | |
| 3094 | 419 f->charset = charset; |
| 428 | 420 f->proportional_p = 0; |
| 421 | |
| 422 retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_font_instance, | |
| 423 (f, name, device, errb)); | |
| 424 | |
| 425 if (!retval) | |
| 426 return Qnil; | |
| 427 | |
| 793 | 428 return wrap_font_instance (f); |
| 428 | 429 } |
| 430 | |
| 431 DEFUN ("font-instance-p", Ffont_instance_p, 1, 1, 0, /* | |
| 432 Return non-nil if OBJECT is a font instance. | |
| 433 */ | |
| 434 (object)) | |
| 435 { | |
| 436 return FONT_INSTANCEP (object) ? Qt : Qnil; | |
| 437 } | |
| 438 | |
| 439 DEFUN ("font-instance-name", Ffont_instance_name, 1, 1, 0, /* | |
| 440 Return the name used to allocate FONT-INSTANCE. | |
| 441 */ | |
| 442 (font_instance)) | |
| 443 { | |
| 444 CHECK_FONT_INSTANCE (font_instance); | |
| 445 return XFONT_INSTANCE (font_instance)->name; | |
| 446 } | |
| 447 | |
| 448 DEFUN ("font-instance-ascent", Ffont_instance_ascent, 1, 1, 0, /* | |
| 449 Return the ascent in pixels of FONT-INSTANCE. | |
| 450 The returned value is the maximum ascent for all characters in the font, | |
| 451 where a character's ascent is the number of pixels above (and including) | |
| 452 the baseline. | |
| 453 */ | |
| 454 (font_instance)) | |
| 455 { | |
| 456 CHECK_FONT_INSTANCE (font_instance); | |
| 457 return make_int (XFONT_INSTANCE (font_instance)->ascent); | |
| 458 } | |
| 459 | |
| 460 DEFUN ("font-instance-descent", Ffont_instance_descent, 1, 1, 0, /* | |
| 461 Return the descent in pixels of FONT-INSTANCE. | |
| 462 The returned value is the maximum descent for all characters in the font, | |
| 463 where a character's descent is the number of pixels below the baseline. | |
| 464 \(Many characters to do not have any descent. Typical characters with a | |
| 465 descent are lowercase p and lowercase g.) | |
| 466 */ | |
| 467 (font_instance)) | |
| 468 { | |
| 469 CHECK_FONT_INSTANCE (font_instance); | |
| 470 return make_int (XFONT_INSTANCE (font_instance)->descent); | |
| 471 } | |
| 472 | |
| 473 DEFUN ("font-instance-width", Ffont_instance_width, 1, 1, 0, /* | |
| 474 Return the width in pixels of FONT-INSTANCE. | |
| 475 The returned value is the average width for all characters in the font. | |
| 476 */ | |
| 477 (font_instance)) | |
| 478 { | |
| 479 CHECK_FONT_INSTANCE (font_instance); | |
| 480 return make_int (XFONT_INSTANCE (font_instance)->width); | |
| 481 } | |
| 482 | |
| 483 DEFUN ("font-instance-proportional-p", Ffont_instance_proportional_p, 1, 1, 0, /* | |
| 484 Return whether FONT-INSTANCE is proportional. | |
| 485 This means that different characters in the font have different widths. | |
| 486 */ | |
| 487 (font_instance)) | |
| 488 { | |
| 489 CHECK_FONT_INSTANCE (font_instance); | |
| 490 return XFONT_INSTANCE (font_instance)->proportional_p ? Qt : Qnil; | |
| 491 } | |
| 492 | |
| 493 static Lisp_Object | |
| 494 font_instance_truename_internal (Lisp_Object font_instance, | |
| 578 | 495 Error_Behavior errb) |
| 428 | 496 { |
| 440 | 497 Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance); |
| 498 | |
| 428 | 499 if (NILP (f->device)) |
| 500 { | |
|
4757
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4426
diff
changeset
|
501 maybe_signal_error (Qgui_error, |
|
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4426
diff
changeset
|
502 "can't determine truename: " |
|
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4426
diff
changeset
|
503 "no device for font instance", |
|
a23ac8f90a49
Improve warning and error messages from Xft.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4426
diff
changeset
|
504 font_instance, Qfont, errb); |
| 428 | 505 return Qnil; |
| 506 } | |
| 440 | 507 |
| 428 | 508 return DEVMETH_OR_GIVEN (XDEVICE (f->device), |
| 509 font_instance_truename, (f, errb), f->name); | |
| 510 } | |
| 511 | |
| 512 DEFUN ("font-instance-truename", Ffont_instance_truename, 1, 1, 0, /* | |
| 513 Return the canonical name of FONT-INSTANCE. | |
| 514 Font names are patterns which may match any number of fonts, of which | |
| 515 the first found is used. This returns an unambiguous name for that font | |
| 516 \(but not necessarily its only unambiguous name). | |
| 517 */ | |
| 518 (font_instance)) | |
| 519 { | |
| 520 CHECK_FONT_INSTANCE (font_instance); | |
| 521 return font_instance_truename_internal (font_instance, ERROR_ME); | |
| 522 } | |
| 523 | |
| 3094 | 524 DEFUN ("font-instance-charset", Ffont_instance_charset, 1, 1, 0, /* |
| 525 Return the Mule charset that FONT-INSTANCE was allocated to handle. | |
| 526 */ | |
| 527 (font_instance)) | |
| 528 { | |
| 529 CHECK_FONT_INSTANCE (font_instance); | |
| 530 return XFONT_INSTANCE (font_instance)->charset; | |
| 531 } | |
| 532 | |
| 428 | 533 DEFUN ("font-instance-properties", Ffont_instance_properties, 1, 1, 0, /* |
| 534 Return the properties (an alist or nil) of FONT-INSTANCE. | |
| 535 */ | |
| 536 (font_instance)) | |
| 537 { | |
| 440 | 538 Lisp_Font_Instance *f; |
| 428 | 539 |
| 540 CHECK_FONT_INSTANCE (font_instance); | |
| 541 f = XFONT_INSTANCE (font_instance); | |
| 542 | |
| 543 if (NILP (f->device)) | |
| 544 return Qnil; | |
| 545 | |
| 546 return MAYBE_LISP_DEVMETH (XDEVICE (f->device), | |
| 547 font_instance_properties, (f)); | |
| 548 } | |
| 549 | |
| 2527 | 550 DEFUN ("font-list", Ffont_list, 1, 3, 0, /* |
| 428 | 551 Return a list of font names matching the given pattern. |
| 552 DEVICE specifies which device to search for names, and defaults to the | |
| 553 currently selected device. | |
| 554 */ | |
| 1701 | 555 (pattern, device, maxnumber)) |
| 428 | 556 { |
| 557 CHECK_STRING (pattern); | |
| 793 | 558 device = wrap_device (decode_device (device)); |
| 428 | 559 |
| 2527 | 560 return MAYBE_LISP_DEVMETH (XDEVICE (device), font_list, (pattern, device, |
| 1701 | 561 maxnumber)); |
| 428 | 562 } |
| 563 | |
| 564 | |
| 565 /**************************************************************************** | |
| 566 Color Object | |
| 567 ***************************************************************************/ | |
| 1204 | 568 |
| 569 static const struct memory_description color_specifier_description[] = { | |
| 570 { XD_LISP_OBJECT, offsetof (struct color_specifier, face) }, | |
| 571 { XD_LISP_OBJECT, offsetof (struct color_specifier, face_property) }, | |
| 572 { XD_END } | |
| 573 }; | |
| 574 | |
| 575 DEFINE_SPECIFIER_TYPE_WITH_DATA (color); | |
| 428 | 576 /* Qcolor defined in general.c */ |
| 577 | |
| 578 static void | |
| 579 color_create (Lisp_Object obj) | |
| 580 { | |
| 440 | 581 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); |
| 428 | 582 |
| 583 COLOR_SPECIFIER_FACE (color) = Qnil; | |
| 584 COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil; | |
| 585 } | |
| 586 | |
| 587 static void | |
| 588 color_mark (Lisp_Object obj) | |
| 589 { | |
| 440 | 590 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); |
| 428 | 591 |
| 592 mark_object (COLOR_SPECIFIER_FACE (color)); | |
| 593 mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color)); | |
| 594 } | |
| 595 | |
| 596 /* No equal or hash methods; ignore the face the color is based off | |
| 597 of for `equal' */ | |
| 598 | |
| 599 static Lisp_Object | |
| 2286 | 600 color_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), |
| 428 | 601 Lisp_Object domain, Lisp_Object instantiator, |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
602 Lisp_Object depth, int no_fallback) |
| 428 | 603 { |
| 604 /* When called, we're inside of call_with_suspended_errors(), | |
| 605 so we can freely error. */ | |
| 442 | 606 Lisp_Object device = DOMAIN_DEVICE (domain); |
| 428 | 607 struct device *d = XDEVICE (device); |
| 608 | |
| 609 if (COLOR_INSTANCEP (instantiator)) | |
| 610 { | |
| 611 /* If we are on the same device then we're done. Otherwise change | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
612 the instantiator to the name used to generate the pixel and let the |
|
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
613 STRINGP case deal with it. */ |
| 428 | 614 if (NILP (device) /* Vthe_null_color_instance */ |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
615 || EQ (device, XCOLOR_INSTANCE (instantiator)->device)) |
| 428 | 616 return instantiator; |
| 617 else | |
| 618 instantiator = Fcolor_instance_name (instantiator); | |
| 619 } | |
| 620 | |
| 621 if (STRINGP (instantiator)) | |
| 622 { | |
| 623 /* First, look to see if we can retrieve a cached value. */ | |
| 624 Lisp_Object instance = | |
| 625 Fgethash (instantiator, d->color_instance_cache, Qunbound); | |
| 626 /* Otherwise, make a new one. */ | |
| 627 if (UNBOUNDP (instance)) | |
| 628 { | |
| 629 /* make sure we cache the failures, too. */ | |
| 630 instance = Fmake_color_instance (instantiator, device, Qt); | |
| 631 Fputhash (instantiator, instance, d->color_instance_cache); | |
| 632 } | |
| 633 | |
| 634 return NILP (instance) ? Qunbound : instance; | |
| 635 } | |
| 636 else if (VECTORP (instantiator)) | |
| 637 { | |
| 638 switch (XVECTOR_LENGTH (instantiator)) | |
| 639 { | |
| 640 case 0: | |
| 641 if (DEVICE_TTY_P (d)) | |
| 642 return Vthe_null_color_instance; | |
| 643 else | |
| 563 | 644 gui_error ("Color instantiator [] only valid on TTY's", |
| 428 | 645 device); |
| 646 | |
| 647 case 1: | |
| 648 if (NILP (COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)))) | |
| 563 | 649 gui_error ("Color specifier not attached to a face", |
| 428 | 650 instantiator); |
| 651 return (FACE_PROPERTY_INSTANCE_1 | |
| 652 (Fget_face (XVECTOR_DATA (instantiator)[0]), | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
653 COLOR_SPECIFIER_FACE_PROPERTY |
|
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
654 (XCOLOR_SPECIFIER (specifier)), |
|
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
655 domain, ERROR_ME, no_fallback, depth)); |
| 428 | 656 |
| 657 case 2: | |
| 658 return (FACE_PROPERTY_INSTANCE_1 | |
| 659 (Fget_face (XVECTOR_DATA (instantiator)[0]), | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
660 XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, |
|
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
661 no_fallback, depth)); |
| 428 | 662 |
| 663 default: | |
| 2500 | 664 ABORT (); |
| 428 | 665 } |
| 666 } | |
| 667 else if (NILP (instantiator)) | |
| 668 { | |
| 669 if (DEVICE_TTY_P (d)) | |
| 670 return Vthe_null_color_instance; | |
| 671 else | |
| 563 | 672 gui_error ("Color instantiator [] only valid on TTY's", |
| 428 | 673 device); |
| 674 } | |
| 675 else | |
| 2500 | 676 ABORT (); /* The spec validation routines are screwed up. */ |
| 428 | 677 |
| 678 return Qunbound; | |
| 679 } | |
| 680 | |
| 681 static void | |
| 682 color_validate (Lisp_Object instantiator) | |
| 683 { | |
| 684 if (COLOR_INSTANCEP (instantiator) || STRINGP (instantiator)) | |
| 685 return; | |
| 686 if (VECTORP (instantiator)) | |
| 687 { | |
| 688 if (XVECTOR_LENGTH (instantiator) > 2) | |
| 563 | 689 sferror ("Inheritance vector must be of size 0 - 2", |
| 428 | 690 instantiator); |
| 691 else if (XVECTOR_LENGTH (instantiator) > 0) | |
| 692 { | |
| 693 Lisp_Object face = XVECTOR_DATA (instantiator)[0]; | |
| 694 | |
| 695 Fget_face (face); | |
| 696 if (XVECTOR_LENGTH (instantiator) == 2) | |
| 697 { | |
| 698 Lisp_Object field = XVECTOR_DATA (instantiator)[1]; | |
| 699 if (!EQ (field, Qforeground) && !EQ (field, Qbackground)) | |
| 563 | 700 invalid_constant |
| 428 | 701 ("Inheritance field must be `foreground' or `background'", |
| 702 field); | |
| 703 } | |
| 704 } | |
| 705 } | |
| 706 else | |
| 563 | 707 invalid_argument ("Invalid color instantiator", instantiator); |
| 428 | 708 } |
| 709 | |
| 710 static void | |
| 711 color_after_change (Lisp_Object specifier, Lisp_Object locale) | |
| 712 { | |
| 713 Lisp_Object face = COLOR_SPECIFIER_FACE (XCOLOR_SPECIFIER (specifier)); | |
| 714 Lisp_Object property = | |
| 715 COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier)); | |
| 716 if (!NILP (face)) | |
| 448 | 717 { |
| 718 face_property_was_changed (face, property, locale); | |
| 719 if (BUFFERP (locale)) | |
| 720 XBUFFER (locale)->buffer_local_face_property = 1; | |
| 721 } | |
| 428 | 722 } |
| 723 | |
| 724 void | |
| 725 set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) | |
| 726 { | |
| 440 | 727 Lisp_Specifier *color = XCOLOR_SPECIFIER (obj); |
| 428 | 728 |
| 729 COLOR_SPECIFIER_FACE (color) = face; | |
| 730 COLOR_SPECIFIER_FACE_PROPERTY (color) = property; | |
| 731 } | |
| 732 | |
| 733 DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /* | |
| 734 Return t if OBJECT is a color specifier. | |
| 735 | |
| 442 | 736 See `make-color-specifier' for a description of possible color instantiators. |
| 428 | 737 */ |
| 738 (object)) | |
| 739 { | |
| 740 return COLOR_SPECIFIERP (object) ? Qt : Qnil; | |
| 741 } | |
| 742 | |
| 743 | |
| 744 /**************************************************************************** | |
| 745 Font Object | |
| 746 ***************************************************************************/ | |
| 1204 | 747 |
| 748 static const struct memory_description font_specifier_description[] = { | |
| 749 { XD_LISP_OBJECT, offsetof (struct font_specifier, face) }, | |
| 750 { XD_LISP_OBJECT, offsetof (struct font_specifier, face_property) }, | |
| 751 { XD_END } | |
| 752 }; | |
| 753 | |
| 754 DEFINE_SPECIFIER_TYPE_WITH_DATA (font); | |
| 428 | 755 /* Qfont defined in general.c */ |
| 756 | |
| 757 static void | |
| 758 font_create (Lisp_Object obj) | |
| 759 { | |
| 440 | 760 Lisp_Specifier *font = XFONT_SPECIFIER (obj); |
| 428 | 761 |
| 762 FONT_SPECIFIER_FACE (font) = Qnil; | |
| 763 FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil; | |
| 764 } | |
| 765 | |
| 766 static void | |
| 767 font_mark (Lisp_Object obj) | |
| 768 { | |
| 440 | 769 Lisp_Specifier *font = XFONT_SPECIFIER (obj); |
| 428 | 770 |
| 771 mark_object (FONT_SPECIFIER_FACE (font)); | |
| 772 mark_object (FONT_SPECIFIER_FACE_PROPERTY (font)); | |
| 773 } | |
| 774 | |
| 775 /* No equal or hash methods; ignore the face the font is based off | |
| 776 of for `equal' */ | |
| 777 | |
| 778 #ifdef MULE | |
| 779 | |
| 872 | 780 /* Given a truename font spec (i.e. the font spec should have its registry |
| 781 field filled in), does it support displaying characters from CHARSET? */ | |
| 782 | |
| 783 static int | |
| 428 | 784 font_spec_matches_charset (struct device *d, Lisp_Object charset, |
| 867 | 785 const Ibyte *nonreloc, Lisp_Object reloc, |
| 872 | 786 Bytecount offset, Bytecount length, |
| 3659 | 787 enum font_specifier_matchspec_stages stage) |
| 428 | 788 { |
| 789 return DEVMETH_OR_GIVEN (d, font_spec_matches_charset, | |
| 872 | 790 (d, charset, nonreloc, reloc, offset, length, |
| 791 stage), | |
| 428 | 792 1); |
| 793 } | |
| 794 | |
| 795 static void | |
| 796 font_validate_matchspec (Lisp_Object matchspec) | |
| 797 { | |
| 872 | 798 CHECK_CONS (matchspec); |
| 799 Fget_charset (XCAR (matchspec)); | |
| 3659 | 800 |
| 801 do | |
| 802 { | |
| 803 if (EQ(XCDR(matchspec), Qinitial)) | |
| 804 { | |
| 805 break; | |
| 806 } | |
| 807 if (EQ(XCDR(matchspec), Qfinal)) | |
| 808 { | |
| 809 break; | |
| 810 } | |
| 811 | |
| 812 invalid_argument("Invalid font matchspec stage", | |
| 813 XCDR(matchspec)); | |
| 814 } while (0); | |
| 428 | 815 } |
| 816 | |
| 872 | 817 void |
| 818 initialize_charset_font_caches (struct device *d) | |
| 819 { | |
| 820 /* Note that the following tables are bi-level. */ | |
| 821 d->charset_font_cache_stage_1 = | |
| 822 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 823 d->charset_font_cache_stage_2 = | |
| 824 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 825 } | |
| 826 | |
| 827 void | |
| 828 invalidate_charset_font_caches (Lisp_Object charset) | |
| 829 { | |
| 830 /* Invalidate font cache entries for charset on all devices. */ | |
| 831 Lisp_Object devcons, concons, hash_table; | |
| 832 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 833 { | |
| 834 struct device *d = XDEVICE (XCAR (devcons)); | |
| 835 hash_table = Fgethash (charset, d->charset_font_cache_stage_1, | |
| 836 Qunbound); | |
| 837 if (!UNBOUNDP (hash_table)) | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
838 Fclrhash (hash_table); |
| 872 | 839 hash_table = Fgethash (charset, d->charset_font_cache_stage_2, |
| 840 Qunbound); | |
| 841 if (!UNBOUNDP (hash_table)) | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
842 Fclrhash (hash_table); |
| 872 | 843 } |
| 844 } | |
| 428 | 845 |
| 874 | 846 #endif /* MULE */ |
| 847 | |
| 848 | |
| 428 | 849 static Lisp_Object |
| 2333 | 850 font_instantiate (Lisp_Object UNUSED (specifier), |
| 851 Lisp_Object USED_IF_MULE (matchspec), | |
| 428 | 852 Lisp_Object domain, Lisp_Object instantiator, |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
853 Lisp_Object depth, int no_fallback) |
| 428 | 854 { |
| 855 /* When called, we're inside of call_with_suspended_errors(), | |
| 856 so we can freely error. */ | |
| 442 | 857 Lisp_Object device = DOMAIN_DEVICE (domain); |
| 428 | 858 struct device *d = XDEVICE (device); |
| 859 Lisp_Object instance; | |
| 872 | 860 Lisp_Object charset = Qnil; |
| 1204 | 861 #ifdef MULE |
| 3659 | 862 enum font_specifier_matchspec_stages stage = initial; |
| 428 | 863 |
| 864 if (!UNBOUNDP (matchspec)) | |
| 872 | 865 { |
| 866 charset = Fget_charset (XCAR (matchspec)); | |
| 3659 | 867 |
| 868 #define FROB(new_stage) if (EQ(Q##new_stage, XCDR(matchspec))) \ | |
| 869 { \ | |
| 870 stage = new_stage; \ | |
| 871 } | |
| 872 | |
| 873 FROB(initial) | |
| 874 else FROB(final) | |
| 875 else assert(0); | |
| 876 | |
| 877 #undef FROB | |
| 878 | |
| 872 | 879 } |
| 428 | 880 #endif |
| 881 | |
| 882 if (FONT_INSTANCEP (instantiator)) | |
| 883 { | |
| 884 if (NILP (device) | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
885 || EQ (device, XFONT_INSTANCE (instantiator)->device)) |
| 428 | 886 { |
| 887 #ifdef MULE | |
| 872 | 888 if (font_spec_matches_charset (d, charset, 0, |
| 428 | 889 Ffont_instance_truename |
| 890 (instantiator), | |
| 872 | 891 0, -1, stage)) |
| 1204 | 892 #endif |
| 428 | 893 return instantiator; |
| 894 } | |
| 895 instantiator = Ffont_instance_name (instantiator); | |
| 896 } | |
| 897 | |
| 898 if (STRINGP (instantiator)) | |
| 899 { | |
| 874 | 900 #ifdef MULE |
| 3659 | 901 /* #### rename these caches. */ |
| 872 | 902 Lisp_Object cache = stage ? d->charset_font_cache_stage_2 : |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
903 d->charset_font_cache_stage_1; |
| 874 | 904 #else |
| 905 Lisp_Object cache = d->font_instance_cache; | |
| 906 #endif | |
| 872 | 907 |
| 428 | 908 #ifdef MULE |
| 872 | 909 if (!NILP (charset)) |
| 428 | 910 { |
| 911 /* The instantiator is a font spec that could match many | |
| 912 different fonts. We need to find one of those fonts | |
| 913 whose registry matches the registry of the charset in | |
| 914 MATCHSPEC. This is potentially a very slow operation, | |
| 915 as it involves doing an XListFonts() or equivalent to | |
| 916 iterate over all possible fonts, and a regexp match | |
| 917 on each one. So we cache the results. */ | |
| 918 Lisp_Object matching_font = Qunbound; | |
| 872 | 919 Lisp_Object hash_table = Fgethash (charset, cache, Qunbound); |
| 428 | 920 if (UNBOUNDP (hash_table)) |
| 921 { | |
| 922 /* need to make a sub hash table. */ | |
| 923 hash_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, | |
| 924 HASH_TABLE_EQUAL); | |
| 872 | 925 Fputhash (charset, hash_table, cache); |
| 428 | 926 } |
| 927 else | |
| 928 matching_font = Fgethash (instantiator, hash_table, Qunbound); | |
| 929 | |
| 930 if (UNBOUNDP (matching_font)) | |
| 931 { | |
| 932 /* make sure we cache the failures, too. */ | |
| 933 matching_font = | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
934 DEVMETH_OR_GIVEN (d, find_charset_font, |
|
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
935 (device, instantiator, charset, stage), |
|
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
936 instantiator); |
| 428 | 937 Fputhash (instantiator, matching_font, hash_table); |
| 938 } | |
| 939 if (NILP (matching_font)) | |
| 940 return Qunbound; | |
| 941 instantiator = matching_font; | |
| 942 } | |
| 943 #endif /* MULE */ | |
| 944 | |
| 945 /* First, look to see if we can retrieve a cached value. */ | |
| 872 | 946 instance = Fgethash (instantiator, cache, Qunbound); |
| 428 | 947 /* Otherwise, make a new one. */ |
| 948 if (UNBOUNDP (instance)) | |
| 949 { | |
| 950 /* make sure we cache the failures, too. */ | |
| 3094 | 951 instance = Fmake_font_instance (instantiator, device, Qt, charset); |
| 872 | 952 Fputhash (instantiator, instance, cache); |
| 428 | 953 } |
| 954 | |
| 955 return NILP (instance) ? Qunbound : instance; | |
| 956 } | |
| 957 else if (VECTORP (instantiator)) | |
| 958 { | |
| 3659 | 959 Lisp_Object match_inst = Qunbound; |
| 428 | 960 assert (XVECTOR_LENGTH (instantiator) == 1); |
| 3659 | 961 |
| 962 match_inst = face_property_matching_instance | |
| 963 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
964 charset, domain, ERROR_ME, no_fallback, depth, initial); |
| 3659 | 965 |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
966 if (UNBOUNDP(match_inst)) |
| 3659 | 967 { |
| 968 match_inst = face_property_matching_instance | |
| 969 (Fget_face (XVECTOR_DATA (instantiator)[0]), Qfont, | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
970 charset, domain, ERROR_ME, no_fallback, depth, final); |
| 3659 | 971 } |
| 972 | |
| 973 return match_inst; | |
| 974 | |
| 428 | 975 } |
| 976 else if (NILP (instantiator)) | |
| 977 return Qunbound; | |
| 978 else | |
| 2500 | 979 ABORT (); /* Eh? */ |
| 428 | 980 |
| 981 return Qunbound; | |
| 982 } | |
| 983 | |
| 984 static void | |
| 985 font_validate (Lisp_Object instantiator) | |
| 986 { | |
| 987 if (FONT_INSTANCEP (instantiator) || STRINGP (instantiator)) | |
| 988 return; | |
| 989 if (VECTORP (instantiator)) | |
| 990 { | |
| 991 if (XVECTOR_LENGTH (instantiator) != 1) | |
| 992 { | |
| 563 | 993 sferror |
| 428 | 994 ("Vector length must be one for font inheritance", instantiator); |
| 995 } | |
| 996 Fget_face (XVECTOR_DATA (instantiator)[0]); | |
| 997 } | |
| 998 else | |
| 563 | 999 invalid_argument ("Must be string, vector, or font-instance", |
| 428 | 1000 instantiator); |
| 1001 } | |
| 1002 | |
| 1003 static void | |
| 1004 font_after_change (Lisp_Object specifier, Lisp_Object locale) | |
| 1005 { | |
| 1006 Lisp_Object face = FONT_SPECIFIER_FACE (XFONT_SPECIFIER (specifier)); | |
| 1007 Lisp_Object property = | |
| 1008 FONT_SPECIFIER_FACE_PROPERTY (XFONT_SPECIFIER (specifier)); | |
| 1009 if (!NILP (face)) | |
| 448 | 1010 { |
| 1011 face_property_was_changed (face, property, locale); | |
| 1012 if (BUFFERP (locale)) | |
| 1013 XBUFFER (locale)->buffer_local_face_property = 1; | |
| 1014 } | |
| 428 | 1015 } |
| 1016 | |
| 1017 void | |
| 1018 set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property) | |
| 1019 { | |
| 440 | 1020 Lisp_Specifier *font = XFONT_SPECIFIER (obj); |
| 428 | 1021 |
| 1022 FONT_SPECIFIER_FACE (font) = face; | |
| 1023 FONT_SPECIFIER_FACE_PROPERTY (font) = property; | |
| 1024 } | |
| 1025 | |
| 1026 DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /* | |
| 1027 Return non-nil if OBJECT is a font specifier. | |
| 1028 | |
| 442 | 1029 See `make-font-specifier' for a description of possible font instantiators. |
| 428 | 1030 */ |
| 1031 (object)) | |
| 1032 { | |
| 1033 return FONT_SPECIFIERP (object) ? Qt : Qnil; | |
| 1034 } | |
| 1035 | |
| 1036 | |
| 1037 /***************************************************************************** | |
| 1038 Face Boolean Object | |
| 1039 ****************************************************************************/ | |
| 1204 | 1040 |
| 1041 static const struct memory_description face_boolean_specifier_description[] = { | |
| 1042 { XD_LISP_OBJECT, offsetof (struct face_boolean_specifier, face) }, | |
| 1043 { XD_LISP_OBJECT, offsetof (struct face_boolean_specifier, face_property) }, | |
| 1044 { XD_END } | |
| 1045 }; | |
| 1046 | |
| 1047 DEFINE_SPECIFIER_TYPE_WITH_DATA (face_boolean); | |
| 428 | 1048 Lisp_Object Qface_boolean; |
| 1049 | |
| 1050 static void | |
| 1051 face_boolean_create (Lisp_Object obj) | |
| 1052 { | |
| 440 | 1053 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); |
| 428 | 1054 |
| 1055 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil; | |
| 1056 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil; | |
| 1057 } | |
| 1058 | |
| 1059 static void | |
| 1060 face_boolean_mark (Lisp_Object obj) | |
| 1061 { | |
| 440 | 1062 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); |
| 428 | 1063 |
| 1064 mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean)); | |
| 1065 mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean)); | |
| 1066 } | |
| 1067 | |
| 1068 /* No equal or hash methods; ignore the face the face-boolean is based off | |
| 1069 of for `equal' */ | |
| 1070 | |
| 1071 static Lisp_Object | |
| 2286 | 1072 face_boolean_instantiate (Lisp_Object specifier, |
| 1073 Lisp_Object UNUSED (matchspec), | |
| 428 | 1074 Lisp_Object domain, Lisp_Object instantiator, |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
1075 Lisp_Object depth, int no_fallback) |
| 428 | 1076 { |
| 1077 /* When called, we're inside of call_with_suspended_errors(), | |
| 1078 so we can freely error. */ | |
| 1079 if (NILP (instantiator) || EQ (instantiator, Qt)) | |
| 1080 return instantiator; | |
| 1081 else if (VECTORP (instantiator)) | |
| 1082 { | |
| 1083 Lisp_Object retval; | |
| 1084 Lisp_Object prop; | |
| 1085 int instantiator_len = XVECTOR_LENGTH (instantiator); | |
| 1086 | |
| 1087 assert (instantiator_len >= 1 && instantiator_len <= 3); | |
| 1088 if (instantiator_len > 1) | |
| 1089 prop = XVECTOR_DATA (instantiator)[1]; | |
| 1090 else | |
| 1091 { | |
| 1092 if (NILP (FACE_BOOLEAN_SPECIFIER_FACE | |
| 1093 (XFACE_BOOLEAN_SPECIFIER (specifier)))) | |
| 563 | 1094 gui_error |
| 428 | 1095 ("Face-boolean specifier not attached to a face", instantiator); |
| 1096 prop = FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY | |
| 1097 (XFACE_BOOLEAN_SPECIFIER (specifier)); | |
| 1098 } | |
| 1099 | |
| 1100 retval = (FACE_PROPERTY_INSTANCE_1 | |
| 1101 (Fget_face (XVECTOR_DATA (instantiator)[0]), | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
3659
diff
changeset
|
1102 prop, domain, ERROR_ME, no_fallback, depth)); |
| 428 | 1103 |
| 1104 if (instantiator_len == 3 && !NILP (XVECTOR_DATA (instantiator)[2])) | |
| 1105 retval = NILP (retval) ? Qt : Qnil; | |
| 1106 | |
| 1107 return retval; | |
| 1108 } | |
| 1109 else | |
| 2500 | 1110 ABORT (); /* Eh? */ |
| 428 | 1111 |
| 1112 return Qunbound; | |
| 1113 } | |
| 1114 | |
| 1115 static void | |
| 1116 face_boolean_validate (Lisp_Object instantiator) | |
| 1117 { | |
| 1118 if (NILP (instantiator) || EQ (instantiator, Qt)) | |
| 1119 return; | |
| 1120 else if (VECTORP (instantiator) && | |
| 1121 (XVECTOR_LENGTH (instantiator) >= 1 && | |
| 1122 XVECTOR_LENGTH (instantiator) <= 3)) | |
| 1123 { | |
| 1124 Lisp_Object face = XVECTOR_DATA (instantiator)[0]; | |
| 1125 | |
| 1126 Fget_face (face); | |
| 1127 | |
| 1128 if (XVECTOR_LENGTH (instantiator) > 1) | |
| 1129 { | |
| 1130 Lisp_Object field = XVECTOR_DATA (instantiator)[1]; | |
| 1131 if (!EQ (field, Qunderline) | |
| 1132 && !EQ (field, Qstrikethru) | |
| 1133 && !EQ (field, Qhighlight) | |
| 1134 && !EQ (field, Qdim) | |
| 1135 && !EQ (field, Qblinking) | |
| 1136 && !EQ (field, Qreverse)) | |
| 563 | 1137 invalid_constant ("Invalid face-boolean inheritance field", |
| 428 | 1138 field); |
| 1139 } | |
| 1140 } | |
| 1141 else if (VECTORP (instantiator)) | |
| 563 | 1142 sferror ("Wrong length for face-boolean inheritance spec", |
| 428 | 1143 instantiator); |
| 1144 else | |
| 563 | 1145 invalid_argument ("Face-boolean instantiator must be nil, t, or vector", |
| 428 | 1146 instantiator); |
| 1147 } | |
| 1148 | |
| 1149 static void | |
| 1150 face_boolean_after_change (Lisp_Object specifier, Lisp_Object locale) | |
| 1151 { | |
| 1152 Lisp_Object face = | |
| 1153 FACE_BOOLEAN_SPECIFIER_FACE (XFACE_BOOLEAN_SPECIFIER (specifier)); | |
| 1154 Lisp_Object property = | |
| 1155 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (XFACE_BOOLEAN_SPECIFIER (specifier)); | |
| 1156 if (!NILP (face)) | |
| 448 | 1157 { |
| 1158 face_property_was_changed (face, property, locale); | |
| 1159 if (BUFFERP (locale)) | |
| 1160 XBUFFER (locale)->buffer_local_face_property = 1; | |
| 1161 } | |
| 428 | 1162 } |
| 1163 | |
| 1164 void | |
| 1165 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face, | |
| 1166 Lisp_Object property) | |
| 1167 { | |
| 440 | 1168 Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj); |
| 428 | 1169 |
| 1170 FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face; | |
| 1171 FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property; | |
| 1172 } | |
| 1173 | |
| 1174 DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /* | |
| 1175 Return non-nil if OBJECT is a face-boolean specifier. | |
| 1176 | |
| 442 | 1177 See `make-face-boolean-specifier' for a description of possible |
| 1178 face-boolean instantiators. | |
| 428 | 1179 */ |
| 1180 (object)) | |
| 1181 { | |
| 1182 return FACE_BOOLEAN_SPECIFIERP (object) ? Qt : Qnil; | |
| 1183 } | |
| 1184 | |
| 1185 | |
| 1186 /************************************************************************/ | |
| 1187 /* initialization */ | |
| 1188 /************************************************************************/ | |
| 1189 | |
| 1190 void | |
| 1191 syms_of_objects (void) | |
| 1192 { | |
| 442 | 1193 INIT_LRECORD_IMPLEMENTATION (color_instance); |
| 1194 INIT_LRECORD_IMPLEMENTATION (font_instance); | |
| 1195 | |
| 428 | 1196 DEFSUBR (Fcolor_specifier_p); |
| 1197 DEFSUBR (Ffont_specifier_p); | |
| 1198 DEFSUBR (Fface_boolean_specifier_p); | |
| 1199 | |
| 563 | 1200 DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep); |
| 428 | 1201 DEFSUBR (Fmake_color_instance); |
| 1202 DEFSUBR (Fcolor_instance_p); | |
| 1203 DEFSUBR (Fcolor_instance_name); | |
| 1204 DEFSUBR (Fcolor_instance_rgb_components); | |
| 1205 DEFSUBR (Fvalid_color_name_p); | |
| 2527 | 1206 DEFSUBR (Fcolor_list); |
| 428 | 1207 |
| 563 | 1208 DEFSYMBOL_MULTIWORD_PREDICATE (Qfont_instancep); |
| 428 | 1209 DEFSUBR (Fmake_font_instance); |
| 1210 DEFSUBR (Ffont_instance_p); | |
| 1211 DEFSUBR (Ffont_instance_name); | |
| 1212 DEFSUBR (Ffont_instance_ascent); | |
| 1213 DEFSUBR (Ffont_instance_descent); | |
| 1214 DEFSUBR (Ffont_instance_width); | |
| 3094 | 1215 DEFSUBR (Ffont_instance_charset); |
| 428 | 1216 DEFSUBR (Ffont_instance_proportional_p); |
| 1217 DEFSUBR (Ffont_instance_truename); | |
| 1218 DEFSUBR (Ffont_instance_properties); | |
| 2527 | 1219 DEFSUBR (Ffont_list); |
| 428 | 1220 |
| 1221 /* Qcolor, Qfont defined in general.c */ | |
| 563 | 1222 DEFSYMBOL (Qface_boolean); |
| 428 | 1223 } |
| 1224 | |
| 1225 void | |
| 1226 specifier_type_create_objects (void) | |
| 1227 { | |
| 1228 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (color, "color", "color-specifier-p"); | |
| 1229 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p"); | |
| 1230 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean", | |
| 1231 "face-boolean-specifier-p"); | |
| 1232 | |
| 1233 SPECIFIER_HAS_METHOD (color, instantiate); | |
| 1234 SPECIFIER_HAS_METHOD (font, instantiate); | |
| 1235 SPECIFIER_HAS_METHOD (face_boolean, instantiate); | |
| 1236 | |
| 1237 SPECIFIER_HAS_METHOD (color, validate); | |
| 1238 SPECIFIER_HAS_METHOD (font, validate); | |
| 1239 SPECIFIER_HAS_METHOD (face_boolean, validate); | |
| 1240 | |
| 1241 SPECIFIER_HAS_METHOD (color, create); | |
| 1242 SPECIFIER_HAS_METHOD (font, create); | |
| 1243 SPECIFIER_HAS_METHOD (face_boolean, create); | |
| 1244 | |
| 1245 SPECIFIER_HAS_METHOD (color, mark); | |
| 1246 SPECIFIER_HAS_METHOD (font, mark); | |
| 1247 SPECIFIER_HAS_METHOD (face_boolean, mark); | |
| 1248 | |
| 1249 SPECIFIER_HAS_METHOD (color, after_change); | |
| 1250 SPECIFIER_HAS_METHOD (font, after_change); | |
| 1251 SPECIFIER_HAS_METHOD (face_boolean, after_change); | |
| 1252 | |
| 1253 #ifdef MULE | |
| 1254 SPECIFIER_HAS_METHOD (font, validate_matchspec); | |
| 1255 #endif | |
| 1256 } | |
| 1257 | |
| 1258 void | |
| 1259 reinit_specifier_type_create_objects (void) | |
| 1260 { | |
| 1261 REINITIALIZE_SPECIFIER_TYPE (color); | |
| 1262 REINITIALIZE_SPECIFIER_TYPE (font); | |
| 1263 REINITIALIZE_SPECIFIER_TYPE (face_boolean); | |
| 1264 } | |
| 1265 | |
| 1266 void | |
| 1267 reinit_vars_of_objects (void) | |
| 1268 { | |
| 1269 staticpro_nodump (&Vthe_null_color_instance); | |
| 1270 { | |
| 440 | 1271 Lisp_Color_Instance *c = |
| 3017 | 1272 ALLOC_LCRECORD_TYPE (Lisp_Color_Instance, &lrecord_color_instance); |
| 428 | 1273 c->name = Qnil; |
| 1274 c->device = Qnil; | |
| 1275 c->data = 0; | |
| 1276 | |
| 793 | 1277 Vthe_null_color_instance = wrap_color_instance (c); |
| 428 | 1278 } |
| 1279 | |
| 1280 staticpro_nodump (&Vthe_null_font_instance); | |
| 1281 { | |
| 440 | 1282 Lisp_Font_Instance *f = |
| 3017 | 1283 ALLOC_LCRECORD_TYPE (Lisp_Font_Instance, &lrecord_font_instance); |
| 428 | 1284 f->name = Qnil; |
| 872 | 1285 f->truename = Qnil; |
| 428 | 1286 f->device = Qnil; |
| 1287 f->data = 0; | |
| 1288 | |
| 1289 f->ascent = f->height = 0; | |
| 1290 f->descent = 0; | |
| 1291 f->width = 0; | |
| 1292 f->proportional_p = 0; | |
| 1293 | |
| 793 | 1294 Vthe_null_font_instance = wrap_font_instance (f); |
| 428 | 1295 } |
| 1296 } | |
| 1297 | |
| 1298 void | |
| 1299 vars_of_objects (void) | |
| 1300 { | |
| 1301 } |