Mercurial > hg > xemacs-beta
annotate src/objects-tty.c @ 5124:623d57b7fbe8 ben-lisp-object
separate regular and disksave finalization, print method fixes.
Create separate disksave method and make the finalize method only be for
actual object finalization, not disksave finalization.
Fix places where 0 was given in place of a printer -- print methods are
mandatory, and internal objects formerly without a print method now must
explicitly specify internal_object_printer().
Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (very_old_free_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* buffer.c:
* bytecode.c:
* bytecode.c (Fcompiled_function_p):
* chartab.c:
* console-impl.h:
* console-impl.h (CONSOLE_TYPE_P):
* console.c:
* console.c (set_quit_events):
* data.c:
* data.c (Fmake_ephemeron):
* database.c:
* database.c (finalize_database):
* database.c (Fclose_database):
* device-msw.c:
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device.c:
* elhash.c:
* elhash.c (finalize_hash_table):
* eval.c:
* eval.c (bind_multiple_value_limits):
* event-stream.c:
* event-stream.c (finalize_command_builder):
* events.c:
* events.c (mark_event):
* extents.c:
* extents.c (finalize_extent_info):
* extents.c (uninit_buffer_extents):
* faces.c:
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.h:
* file-coding.h (struct coding_system_methods):
* file-coding.h (struct detector):
* floatfns.c:
* floatfns.c (extract_float):
* fns.c:
* fns.c (Fidentity):
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (finalize_fc_config):
* frame.c:
* glyphs.c:
* glyphs.c (finalize_image_instance):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* gui.c:
* gui.c (gui_error):
* keymap.c:
* lisp.h (struct Lisp_Symbol):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (finalize_lstream):
* lstream.c (disksave_lstream):
* marker.c:
* marker.c (finalize_marker):
* mule-charset.c (make_charset):
* number.c:
* objects.c:
* objects.c (finalize_color_instance):
* objects.c (finalize_font_instance):
* opaque.c:
* opaque.c (make_opaque_ptr):
* process-nt.c:
* process-nt.c (nt_finalize_process_data):
* process-nt.c (nt_deactivate_process):
* process.c:
* process.c (finalize_process):
* procimpl.h (struct process_methods):
* scrollbar.c:
* scrollbar.c (free_scrollbar_instance):
* specifier.c (finalize_specifier):
* symbols.c:
* toolbar.c:
* toolbar.c (Ftoolbar_button_p):
* tooltalk.c:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* window.c:
* window.c (finalize_window):
* window.c (mark_window_as_deleted):
Separate out regular and disksave finalization. Instead of a
FOR_DISKSAVE argument to the finalizer, create a separate object
method `disksaver'. Make `finalizer' have only one argument.
Go through and separate out all finalize methods into finalize
and disksave. Delete lots of thereby redundant disksave checking.
Delete places that signal an error if we attempt to disksave --
all of these objects are non-dumpable and we will get an error
from pdump anyway if we attempt to dump them. After this is done,
only one object remains that has a disksave method -- lstream.
Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT,
which is used for specifying either property methods or disksave
methods (or in the future, any other less-used methods).
Remove the for_disksave argument to finalize_process_data. Don't
provide a disksaver for processes because no one currently needs
it.
Clean up various places where objects didn't provide a print method.
It was made mandatory in previous changes, and all methods now
either provide their own print method or use internal_object_printer
or external_object_printer.
Change the definition of CONSOLE_LIVE_P to use the contype enum
rather than looking into the conmeths structure -- in some weird
situations with dead objects, the conmeths structure is NULL,
and printing such objects from debug_print() will crash if we try
to look into the conmeths structure.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 20 Jan 2010 07:05:57 -0600 |
| parents | d1247f3cc363 |
| children | b5df3737028a |
| rev | line source |
|---|---|
| 428 | 1 /* TTY-specific Lisp objects. |
| 2 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 793 | 3 Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 24 #include <config.h> | |
| 25 #include "lisp.h" | |
| 26 | |
| 872 | 27 #include "console-tty-impl.h" |
| 428 | 28 #include "insdel.h" |
| 872 | 29 #include "objects-tty-impl.h" |
| 428 | 30 #include "device.h" |
| 771 | 31 #include "charset.h" |
| 428 | 32 |
|
4710
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4353
diff
changeset
|
33 #ifdef NEW_GC |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4353
diff
changeset
|
34 # define UNUSED_IF_NEW_GC(decl) UNUSED (decl) |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4353
diff
changeset
|
35 #else |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4353
diff
changeset
|
36 # define UNUSED_IF_NEW_GC(decl) decl |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4353
diff
changeset
|
37 #endif |
|
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4353
diff
changeset
|
38 |
| 428 | 39 /* An alist mapping from color names to a cons of (FG-STRING, BG-STRING). */ |
| 40 Lisp_Object Vtty_color_alist; | |
| 41 #if 0 /* This stuff doesn't quite work yet */ | |
| 42 Lisp_Object Vtty_dynamic_color_fg; | |
| 43 Lisp_Object Vtty_dynamic_color_bg; | |
| 44 #endif | |
| 45 | |
| 1204 | 46 static const struct memory_description tty_color_instance_data_description_1 [] = { |
| 47 { XD_LISP_OBJECT, offsetof (struct tty_color_instance_data, symbol) }, | |
| 48 { XD_END } | |
| 49 }; | |
| 50 | |
| 3092 | 51 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
52 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-color-instance-data", |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
53 tty_color_instance_data, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
54 0, tty_color_instance_data_description_1, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
55 struct tty_color_instance_data); |
| 3092 | 56 #else /* not NEW_GC */ |
| 1204 | 57 const struct sized_memory_description tty_color_instance_data_description = { |
| 58 sizeof (struct tty_color_instance_data), tty_color_instance_data_description_1 | |
| 59 }; | |
| 3092 | 60 #endif /* not NEW_GC */ |
| 1204 | 61 |
| 62 static const struct memory_description tty_font_instance_data_description_1 [] = { | |
| 63 { XD_LISP_OBJECT, offsetof (struct tty_font_instance_data, charset) }, | |
| 64 { XD_END } | |
| 65 }; | |
| 66 | |
| 3092 | 67 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
68 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("tty-font-instance-data", |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
69 tty_font_instance_data, 0, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
70 tty_font_instance_data_description_1, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
71 struct tty_font_instance_data); |
| 3092 | 72 #else /* not NEW_GC */ |
| 1204 | 73 const struct sized_memory_description tty_font_instance_data_description = { |
| 74 sizeof (struct tty_font_instance_data), tty_font_instance_data_description_1 | |
| 75 }; | |
| 3092 | 76 #endif /* not NEW_GC */ |
| 1204 | 77 |
| 428 | 78 DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /* |
| 79 Register COLOR as a recognized TTY color. | |
| 80 COLOR should be a string. | |
| 81 Strings FG-STRING and BG-STRING should specify the escape sequences to | |
| 82 set the foreground and background to the given color, respectively. | |
| 83 */ | |
| 84 (color, fg_string, bg_string)) | |
| 85 { | |
| 86 CHECK_STRING (color); | |
| 87 CHECK_STRING (fg_string); | |
| 88 CHECK_STRING (bg_string); | |
| 89 | |
| 90 color = Fintern (color, Qnil); | |
| 91 Vtty_color_alist = Fremassq (color, Vtty_color_alist); | |
| 92 Vtty_color_alist = Fcons (Fcons (color, Fcons (fg_string, bg_string)), | |
| 93 Vtty_color_alist); | |
| 94 | |
| 95 return Qnil; | |
| 96 } | |
| 97 | |
| 98 DEFUN ("unregister-tty-color", Funregister_tty_color, 1, 1, 0, /* | |
| 99 Unregister COLOR as a recognized TTY color. | |
| 100 */ | |
| 101 (color)) | |
| 102 { | |
| 103 CHECK_STRING (color); | |
| 104 | |
| 105 color = Fintern (color, Qnil); | |
| 106 Vtty_color_alist = Fremassq (color, Vtty_color_alist); | |
| 107 return Qnil; | |
| 108 } | |
| 109 | |
| 110 DEFUN ("find-tty-color", Ffind_tty_color, 1, 1, 0, /* | |
| 111 Look up COLOR in the list of registered TTY colors. | |
| 112 If it is found, return a list (FG-STRING BG-STRING) of the escape | |
| 113 sequences used to set the foreground and background to the color, respectively. | |
| 114 If it is not found, return nil. | |
| 115 */ | |
| 116 (color)) | |
| 117 { | |
| 118 Lisp_Object result; | |
| 119 | |
| 120 CHECK_STRING (color); | |
| 121 | |
| 122 result = Fassq (Fintern (color, Qnil), Vtty_color_alist); | |
| 123 if (!NILP (result)) | |
| 124 return list2 (Fcar (Fcdr (result)), Fcdr (Fcdr (result))); | |
| 125 else | |
| 126 return Qnil; | |
| 127 } | |
| 128 | |
| 2527 | 129 static Lisp_Object |
| 130 tty_color_list (void) | |
| 428 | 131 { |
| 132 Lisp_Object result = Qnil; | |
| 133 Lisp_Object rest; | |
| 134 | |
| 135 LIST_LOOP (rest, Vtty_color_alist) | |
| 136 { | |
| 137 result = Fcons (Fsymbol_name (XCAR (XCAR (rest))), result); | |
| 138 } | |
| 139 | |
| 140 return Fnreverse (result); | |
| 141 } | |
| 142 | |
| 143 #if 0 | |
| 144 | |
| 145 /* This approach is too simplistic. The problem is that the | |
| 146 dynamic color settings apply to *all* text in the default color, | |
| 147 not just the text output after the escape sequence has been given. */ | |
| 148 | |
| 149 DEFUN ("set-tty-dynamic-color-specs", Fset_tty_dynamic_color_specs, 2, 2, 0, /* | |
| 150 Set the dynamic color specifications for TTY's. | |
| 151 FG and BG should be either nil or vaguely printf-like strings, | |
| 152 where each occurrence of %s is replaced with the color name and each | |
| 153 occurrence of %% is replaced with a single % character. | |
| 154 */ | |
| 155 (fg, bg)) | |
| 156 { | |
| 157 if (!NILP (fg)) | |
| 158 CHECK_STRING (fg); | |
| 159 if (!NILP (bg)) | |
| 160 CHECK_STRING (bg); | |
| 161 | |
| 162 Vtty_dynamic_color_fg = fg; | |
| 163 Vtty_dynamic_color_bg = bg; | |
| 164 | |
| 165 return Qnil; | |
| 166 } | |
| 167 | |
| 168 DEFUN ("tty-dynamic-color-specs", Ftty_dynamic_color_specs, 0, 0, 0, /* | |
| 169 Return the dynamic color specifications for TTY's as a list of (FG BG). | |
| 170 See `set-tty-dynamic-color-specs'. | |
| 171 */ | |
| 172 ()) | |
| 173 { | |
| 174 return list2 (Vtty_dynamic_color_fg, Vtty_dynamic_color_bg); | |
| 175 } | |
| 176 | |
| 177 #endif /* 0 */ | |
| 178 | |
| 179 static int | |
| 440 | 180 tty_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, |
| 2286 | 181 Lisp_Object UNUSED (device), |
| 182 Error_Behavior UNUSED (errb)) | |
| 428 | 183 { |
| 184 Lisp_Object result; | |
| 185 | |
| 186 name = Fintern (name, Qnil); | |
| 187 result = assq_no_quit (name, Vtty_color_alist); | |
| 188 | |
| 189 if (NILP (result)) | |
| 190 { | |
| 191 #if 0 | |
| 192 if (!STRINGP (Vtty_dynamic_color_fg) | |
| 193 && !STRINGP (Vtty_dynamic_color_bg)) | |
| 194 #endif | |
| 195 return 0; | |
| 196 } | |
| 197 | |
| 198 /* Don't allocate the data until we're sure that we will succeed. */ | |
| 3092 | 199 #ifdef NEW_GC |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
200 c->data = |
|
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
201 XTTY_COLOR_INSTANCE_DATA (ALLOC_LISP_OBJECT (tty_color_instance_data)); |
| 3092 | 202 #else /* not NEW_GC */ |
| 428 | 203 c->data = xnew (struct tty_color_instance_data); |
| 3092 | 204 #endif /* not NEW_GC */ |
| 428 | 205 COLOR_INSTANCE_TTY_SYMBOL (c) = name; |
| 206 | |
| 207 return 1; | |
| 208 } | |
| 209 | |
| 210 static void | |
| 440 | 211 tty_mark_color_instance (Lisp_Color_Instance *c) |
| 428 | 212 { |
| 213 mark_object (COLOR_INSTANCE_TTY_SYMBOL (c)); | |
| 214 } | |
| 215 | |
| 216 static void | |
| 2286 | 217 tty_print_color_instance (Lisp_Color_Instance *UNUSED (c), |
| 218 Lisp_Object UNUSED (printcharfun), | |
| 219 int UNUSED (escapeflag)) | |
| 428 | 220 { |
| 221 } | |
| 222 | |
| 223 static void | |
|
4710
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4353
diff
changeset
|
224 tty_finalize_color_instance (Lisp_Color_Instance *UNUSED_IF_NEW_GC (c)) |
| 428 | 225 { |
| 4141 | 226 #ifndef NEW_GC |
| 428 | 227 if (c->data) |
| 1726 | 228 xfree (c->data, void *); |
| 4141 | 229 #endif /* not NEW_GC */ |
| 4117 | 230 } |
| 428 | 231 |
| 232 static int | |
| 440 | 233 tty_color_instance_equal (Lisp_Color_Instance *c1, |
| 234 Lisp_Color_Instance *c2, | |
| 2286 | 235 int UNUSED (depth)) |
| 428 | 236 { |
| 237 return (EQ (COLOR_INSTANCE_TTY_SYMBOL (c1), | |
| 238 COLOR_INSTANCE_TTY_SYMBOL (c2))); | |
| 239 } | |
| 240 | |
| 2515 | 241 static Hashcode |
| 2286 | 242 tty_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) |
| 428 | 243 { |
| 244 return LISP_HASH (COLOR_INSTANCE_TTY_SYMBOL (c)); | |
| 245 } | |
| 246 | |
| 247 static int | |
| 2286 | 248 tty_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) |
| 428 | 249 { |
| 250 return (!NILP (assoc_no_quit (Fintern (color, Qnil), Vtty_color_alist))); | |
| 251 #if 0 | |
| 252 || STRINGP (Vtty_dynamic_color_fg) | |
| 253 || STRINGP (Vtty_dynamic_color_bg) | |
| 254 #endif | |
| 255 } | |
| 256 | |
| 257 | |
| 258 static int | |
| 440 | 259 tty_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, |
| 2286 | 260 Lisp_Object UNUSED (device), |
| 261 Error_Behavior UNUSED (errb)) | |
| 428 | 262 { |
| 867 | 263 Ibyte *str = XSTRING_DATA (name); |
| 428 | 264 Lisp_Object charset = Qnil; |
| 265 | |
| 2367 | 266 if (qxestrncmp_ascii (str, "normal", 6)) |
| 428 | 267 return 0; |
| 268 str += 6; | |
| 269 if (*str) | |
| 270 { | |
| 271 #ifdef MULE | |
| 272 if (*str != '/') | |
| 273 return 0; | |
| 274 str++; | |
| 771 | 275 charset = Ffind_charset (intern_int (str)); |
| 428 | 276 if (NILP (charset)) |
| 277 return 0; | |
| 278 #else | |
| 279 return 0; | |
| 280 #endif | |
| 281 } | |
| 282 | |
| 283 /* Don't allocate the data until we're sure that we will succeed. */ | |
| 3092 | 284 #ifdef NEW_GC |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
285 f->data = |
|
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
286 XTTY_FONT_INSTANCE_DATA (ALLOC_LISP_OBJECT (tty_font_instance_data)); |
| 3092 | 287 #else /* not NEW_GC */ |
| 428 | 288 f->data = xnew (struct tty_font_instance_data); |
| 3092 | 289 #endif /* not NEW_GC */ |
| 428 | 290 FONT_INSTANCE_TTY_CHARSET (f) = charset; |
| 291 #ifdef MULE | |
| 292 if (CHARSETP (charset)) | |
| 293 f->width = XCHARSET_COLUMNS (charset); | |
| 294 else | |
| 295 #endif | |
| 296 f->width = 1; | |
| 297 | |
| 298 f->proportional_p = 0; | |
| 299 f->ascent = f->height = 1; | |
| 300 f->descent = 0; | |
| 301 | |
| 302 return 1; | |
| 303 } | |
| 304 | |
| 305 static void | |
| 440 | 306 tty_mark_font_instance (Lisp_Font_Instance *f) |
| 428 | 307 { |
| 308 mark_object (FONT_INSTANCE_TTY_CHARSET (f)); | |
| 309 } | |
| 310 | |
| 311 static void | |
| 2286 | 312 tty_print_font_instance (Lisp_Font_Instance *UNUSED (f), |
| 313 Lisp_Object UNUSED (printcharfun), | |
| 314 int UNUSED (escapeflag)) | |
| 428 | 315 { |
| 316 } | |
| 317 | |
| 318 static void | |
|
4710
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4353
diff
changeset
|
319 tty_finalize_font_instance (Lisp_Font_Instance *UNUSED_IF_NEW_GC (f)) |
| 428 | 320 { |
| 4141 | 321 #ifndef NEW_GC |
| 428 | 322 if (f->data) |
| 1726 | 323 xfree (f->data, void *); |
| 4141 | 324 #endif /* not NEW_GC */ |
| 4117 | 325 } |
| 428 | 326 |
| 327 static Lisp_Object | |
| 2527 | 328 tty_font_list (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device), |
| 2286 | 329 Lisp_Object UNUSED (maxnumber)) |
| 428 | 330 { |
| 331 return list1 (build_string ("normal")); | |
| 332 } | |
| 333 | |
| 334 #ifdef MULE | |
| 335 | |
| 336 static int | |
| 2286 | 337 tty_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset, |
| 867 | 338 const Ibyte *nonreloc, Lisp_Object reloc, |
| 872 | 339 Bytecount offset, Bytecount length, |
| 3841 | 340 enum font_specifier_matchspec_stages stage) |
| 428 | 341 { |
| 867 | 342 const Ibyte *the_nonreloc = nonreloc; |
| 428 | 343 |
| 872 | 344 if (stage) |
| 345 return 0; | |
| 346 | |
| 428 | 347 if (!the_nonreloc) |
| 348 the_nonreloc = XSTRING_DATA (reloc); | |
| 349 fixup_internal_substring (nonreloc, reloc, offset, &length); | |
| 350 the_nonreloc += offset; | |
| 351 | |
|
4353
4143b78d0df0
Merge an old patch of Ben's, involving font instantiation and charsets.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
352 if (NILP (charset)) |
| 428 | 353 return !memchr (the_nonreloc, '/', length); |
| 867 | 354 the_nonreloc = (const Ibyte *) memchr (the_nonreloc, '/', length); |
| 428 | 355 if (!the_nonreloc) |
| 356 return 0; | |
| 357 the_nonreloc++; | |
| 358 { | |
| 793 | 359 Lisp_Object s = symbol_name (XSYMBOL (XCHARSET_NAME (charset))); |
| 360 return !qxestrcmp (the_nonreloc, XSTRING_DATA (s)); | |
| 428 | 361 } |
| 362 } | |
| 363 | |
| 364 /* find a font spec that matches font spec FONT and also matches | |
| 365 (the registry of) CHARSET. */ | |
| 366 static Lisp_Object | |
| 367 tty_find_charset_font (Lisp_Object device, Lisp_Object font, | |
| 3659 | 368 Lisp_Object charset, |
| 369 enum font_specifier_matchspec_stages stage) | |
| 428 | 370 { |
| 867 | 371 Ibyte *fontname = XSTRING_DATA (font); |
| 428 | 372 |
| 872 | 373 if (stage) |
| 374 return Qnil; | |
| 375 | |
| 442 | 376 if (strchr ((const char *) fontname, '/')) |
| 428 | 377 { |
| 378 if (tty_font_spec_matches_charset (XDEVICE (device), charset, 0, | |
| 4124 | 379 font, 0, -1, initial)) |
| 428 | 380 return font; |
| 381 return Qnil; | |
| 382 } | |
| 383 | |
|
4353
4143b78d0df0
Merge an old patch of Ben's, involving font instantiation and charsets.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
384 if (NILP (charset)) |
| 428 | 385 return font; |
| 386 | |
| 387 return concat3 (font, build_string ("/"), | |
| 388 Fsymbol_name (XCHARSET_NAME (charset))); | |
| 389 } | |
| 390 | |
| 391 #endif /* MULE */ | |
| 392 | |
| 393 | |
| 394 /************************************************************************/ | |
| 395 /* initialization */ | |
| 396 /************************************************************************/ | |
| 397 | |
| 398 void | |
| 399 syms_of_objects_tty (void) | |
| 400 { | |
| 3092 | 401 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
402 INIT_LISP_OBJECT (tty_color_instance_data); |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
403 INIT_LISP_OBJECT (tty_font_instance_data); |
| 3092 | 404 #endif /* NEW_GC */ |
| 405 | |
| 428 | 406 DEFSUBR (Fregister_tty_color); |
| 407 DEFSUBR (Funregister_tty_color); | |
| 408 DEFSUBR (Ffind_tty_color); | |
| 409 #if 0 | |
| 410 DEFSUBR (Fset_tty_dynamic_color_specs); | |
| 411 DEFSUBR (Ftty_dynamic_color_specs); | |
| 412 #endif | |
| 413 } | |
| 414 | |
| 415 void | |
| 416 console_type_create_objects_tty (void) | |
| 417 { | |
| 418 /* object methods */ | |
| 419 CONSOLE_HAS_METHOD (tty, initialize_color_instance); | |
| 420 CONSOLE_HAS_METHOD (tty, mark_color_instance); | |
| 421 CONSOLE_HAS_METHOD (tty, print_color_instance); | |
| 422 CONSOLE_HAS_METHOD (tty, finalize_color_instance); | |
| 423 CONSOLE_HAS_METHOD (tty, color_instance_equal); | |
| 424 CONSOLE_HAS_METHOD (tty, color_instance_hash); | |
| 425 CONSOLE_HAS_METHOD (tty, valid_color_name_p); | |
| 2527 | 426 CONSOLE_HAS_METHOD (tty, color_list); |
| 428 | 427 |
| 428 CONSOLE_HAS_METHOD (tty, initialize_font_instance); | |
| 429 CONSOLE_HAS_METHOD (tty, mark_font_instance); | |
| 430 CONSOLE_HAS_METHOD (tty, print_font_instance); | |
| 431 CONSOLE_HAS_METHOD (tty, finalize_font_instance); | |
| 2527 | 432 CONSOLE_HAS_METHOD (tty, font_list); |
| 428 | 433 #ifdef MULE |
| 434 CONSOLE_HAS_METHOD (tty, font_spec_matches_charset); | |
| 435 CONSOLE_HAS_METHOD (tty, find_charset_font); | |
| 436 #endif | |
| 437 } | |
| 438 | |
| 439 void | |
| 440 vars_of_objects_tty (void) | |
| 441 { | |
| 442 staticpro (&Vtty_color_alist); | |
| 443 Vtty_color_alist = Qnil; | |
| 444 | |
| 445 #if 0 | |
| 446 staticpro (&Vtty_dynamic_color_fg); | |
| 447 Vtty_dynamic_color_fg = Qnil; | |
| 448 | |
| 449 staticpro (&Vtty_dynamic_color_bg); | |
| 450 Vtty_dynamic_color_bg = Qnil; | |
| 451 #endif | |
| 452 } |