Mercurial > hg > xemacs-beta
annotate src/fontcolor-tty.c @ 5602:c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
src/ChangeLog addition:
2011-11-26 Aidan Kehoe <kehoea@parhasard.net>
* number-mp.c (bignum_to_string):
Don't overwrite the accumulator we've just set up for this
function.
* number-mp.c (BIGNUM_TO_TYPE):
mp_itom() doesn't necessarily do what this code used to think with
negative numbers, it can treat them as unsigned ints. Subtract
numbers from bignum_zero instead of multiplying them by -1 to
convert them to their negative equivalents.
* number-mp.c (bignum_to_int):
* number-mp.c (bignum_to_uint):
* number-mp.c (bignum_to_long):
* number-mp.c (bignum_to_ulong):
* number-mp.c (bignum_to_double):
Use the changed BIGNUM_TO_TYPE() in these functions.
* number-mp.c (bignum_ceil):
* number-mp.c (bignum_floor):
In these functions, be more careful about rounding to positive and
negative infinity, respectively. Don't use the sign of QUOTIENT
when working out out whether to add or subtract one, rather use
the sign QUOTIENT would have if arbitrary-precision division were
done.
* number-mp.h:
* number-mp.h (MP_GCD):
Wrap #include <mp.h> in BEGIN_C_DECLS/END_C_DECLS.
* number.c (Fbigfloat_get_precision):
* number.c (Fbigfloat_set_precision):
Don't attempt to call XBIGFLOAT_GET_PREC if this build doesn't
support big floats.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 26 Nov 2011 17:59:14 +0000 |
| parents | 10f179710250 |
| children |
| rev | line source |
|---|---|
| 428 | 1 /* TTY-specific Lisp objects. |
| 2 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
|
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
3 Copyright (C) 1995, 1996, 2001, 2002, 2010 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5178
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 8 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5178
diff
changeset
|
9 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5178
diff
changeset
|
10 option) any later version. |
| 428 | 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5178
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 19 |
| 20 /* Synched up with: Not in FSF. */ | |
| 21 | |
| 22 #include <config.h> | |
| 23 #include "lisp.h" | |
| 24 | |
| 872 | 25 #include "console-tty-impl.h" |
| 428 | 26 #include "insdel.h" |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5046
diff
changeset
|
27 #include "fontcolor-tty-impl.h" |
| 428 | 28 #include "device.h" |
| 771 | 29 #include "charset.h" |
| 428 | 30 |
| 31 /* An alist mapping from color names to a cons of (FG-STRING, BG-STRING). */ | |
| 32 Lisp_Object Vtty_color_alist; | |
| 33 #if 0 /* This stuff doesn't quite work yet */ | |
| 34 Lisp_Object Vtty_dynamic_color_fg; | |
| 35 Lisp_Object Vtty_dynamic_color_bg; | |
| 36 #endif | |
| 37 | |
| 1204 | 38 static const struct memory_description tty_color_instance_data_description_1 [] = { |
| 39 { XD_LISP_OBJECT, offsetof (struct tty_color_instance_data, symbol) }, | |
| 40 { XD_END } | |
| 41 }; | |
| 42 | |
| 3092 | 43 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
44 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
|
45 tty_color_instance_data, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
46 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
|
47 struct tty_color_instance_data); |
| 3092 | 48 #else /* not NEW_GC */ |
| 1204 | 49 const struct sized_memory_description tty_color_instance_data_description = { |
| 50 sizeof (struct tty_color_instance_data), tty_color_instance_data_description_1 | |
| 51 }; | |
| 3092 | 52 #endif /* not NEW_GC */ |
| 1204 | 53 |
| 54 static const struct memory_description tty_font_instance_data_description_1 [] = { | |
| 55 { XD_LISP_OBJECT, offsetof (struct tty_font_instance_data, charset) }, | |
| 56 { XD_END } | |
| 57 }; | |
| 58 | |
| 3092 | 59 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
60 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
|
61 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
|
62 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
|
63 struct tty_font_instance_data); |
| 3092 | 64 #else /* not NEW_GC */ |
| 1204 | 65 const struct sized_memory_description tty_font_instance_data_description = { |
| 66 sizeof (struct tty_font_instance_data), tty_font_instance_data_description_1 | |
| 67 }; | |
| 3092 | 68 #endif /* not NEW_GC */ |
| 1204 | 69 |
| 428 | 70 DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /* |
| 71 Register COLOR as a recognized TTY color. | |
| 72 COLOR should be a string. | |
| 73 Strings FG-STRING and BG-STRING should specify the escape sequences to | |
| 74 set the foreground and background to the given color, respectively. | |
| 75 */ | |
| 76 (color, fg_string, bg_string)) | |
| 77 { | |
| 78 CHECK_STRING (color); | |
| 79 CHECK_STRING (fg_string); | |
| 80 CHECK_STRING (bg_string); | |
| 81 | |
| 82 color = Fintern (color, Qnil); | |
|
5583
10f179710250
Deprecate #'remassoc, #'remassq, #'remrassoc, #'remrassq.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
83 Vtty_color_alist = remassq_no_quit (color, Vtty_color_alist); |
| 428 | 84 Vtty_color_alist = Fcons (Fcons (color, Fcons (fg_string, bg_string)), |
| 85 Vtty_color_alist); | |
| 86 | |
| 87 return Qnil; | |
| 88 } | |
| 89 | |
| 90 DEFUN ("unregister-tty-color", Funregister_tty_color, 1, 1, 0, /* | |
| 91 Unregister COLOR as a recognized TTY color. | |
| 92 */ | |
| 93 (color)) | |
| 94 { | |
| 95 CHECK_STRING (color); | |
| 96 | |
| 97 color = Fintern (color, Qnil); | |
|
5583
10f179710250
Deprecate #'remassoc, #'remassq, #'remrassoc, #'remrassq.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
98 Vtty_color_alist = remassq_no_quit (color, Vtty_color_alist); |
| 428 | 99 return Qnil; |
| 100 } | |
| 101 | |
| 102 DEFUN ("find-tty-color", Ffind_tty_color, 1, 1, 0, /* | |
| 103 Look up COLOR in the list of registered TTY colors. | |
| 104 If it is found, return a list (FG-STRING BG-STRING) of the escape | |
| 105 sequences used to set the foreground and background to the color, respectively. | |
| 106 If it is not found, return nil. | |
| 107 */ | |
| 108 (color)) | |
| 109 { | |
| 110 Lisp_Object result; | |
| 111 | |
| 112 CHECK_STRING (color); | |
| 113 | |
|
5583
10f179710250
Deprecate #'remassoc, #'remassq, #'remrassoc, #'remrassq.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
114 result = assq_no_quit (Fintern (color, Qnil), Vtty_color_alist); |
| 428 | 115 if (!NILP (result)) |
| 116 return list2 (Fcar (Fcdr (result)), Fcdr (Fcdr (result))); | |
| 117 else | |
| 118 return Qnil; | |
| 119 } | |
| 120 | |
| 2527 | 121 static Lisp_Object |
| 122 tty_color_list (void) | |
| 428 | 123 { |
| 124 Lisp_Object result = Qnil; | |
| 125 Lisp_Object rest; | |
| 126 | |
| 127 LIST_LOOP (rest, Vtty_color_alist) | |
| 128 { | |
| 129 result = Fcons (Fsymbol_name (XCAR (XCAR (rest))), result); | |
| 130 } | |
| 131 | |
| 132 return Fnreverse (result); | |
| 133 } | |
| 134 | |
| 135 #if 0 | |
| 136 | |
| 137 /* This approach is too simplistic. The problem is that the | |
| 138 dynamic color settings apply to *all* text in the default color, | |
| 139 not just the text output after the escape sequence has been given. */ | |
| 140 | |
| 141 DEFUN ("set-tty-dynamic-color-specs", Fset_tty_dynamic_color_specs, 2, 2, 0, /* | |
| 142 Set the dynamic color specifications for TTY's. | |
| 143 FG and BG should be either nil or vaguely printf-like strings, | |
| 144 where each occurrence of %s is replaced with the color name and each | |
| 145 occurrence of %% is replaced with a single % character. | |
| 146 */ | |
| 147 (fg, bg)) | |
| 148 { | |
| 149 if (!NILP (fg)) | |
| 150 CHECK_STRING (fg); | |
| 151 if (!NILP (bg)) | |
| 152 CHECK_STRING (bg); | |
| 153 | |
| 154 Vtty_dynamic_color_fg = fg; | |
| 155 Vtty_dynamic_color_bg = bg; | |
| 156 | |
| 157 return Qnil; | |
| 158 } | |
| 159 | |
| 160 DEFUN ("tty-dynamic-color-specs", Ftty_dynamic_color_specs, 0, 0, 0, /* | |
| 161 Return the dynamic color specifications for TTY's as a list of (FG BG). | |
| 162 See `set-tty-dynamic-color-specs'. | |
| 163 */ | |
| 164 ()) | |
| 165 { | |
| 166 return list2 (Vtty_dynamic_color_fg, Vtty_dynamic_color_bg); | |
| 167 } | |
| 168 | |
| 169 #endif /* 0 */ | |
| 170 | |
| 171 static int | |
| 440 | 172 tty_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name, |
| 2286 | 173 Lisp_Object UNUSED (device), |
| 174 Error_Behavior UNUSED (errb)) | |
| 428 | 175 { |
| 176 Lisp_Object result; | |
| 177 | |
| 178 name = Fintern (name, Qnil); | |
| 179 result = assq_no_quit (name, Vtty_color_alist); | |
| 180 | |
| 181 if (NILP (result)) | |
| 182 { | |
| 183 #if 0 | |
| 184 if (!STRINGP (Vtty_dynamic_color_fg) | |
| 185 && !STRINGP (Vtty_dynamic_color_bg)) | |
| 186 #endif | |
| 187 return 0; | |
| 188 } | |
| 189 | |
| 190 /* Don't allocate the data until we're sure that we will succeed. */ | |
| 3092 | 191 #ifdef NEW_GC |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
192 c->data = |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
193 XTTY_COLOR_INSTANCE_DATA (ALLOC_NORMAL_LISP_OBJECT (tty_color_instance_data)); |
| 3092 | 194 #else /* not NEW_GC */ |
| 428 | 195 c->data = xnew (struct tty_color_instance_data); |
| 3092 | 196 #endif /* not NEW_GC */ |
| 428 | 197 COLOR_INSTANCE_TTY_SYMBOL (c) = name; |
| 198 | |
| 199 return 1; | |
| 200 } | |
| 201 | |
| 202 static void | |
| 440 | 203 tty_mark_color_instance (Lisp_Color_Instance *c) |
| 428 | 204 { |
| 205 mark_object (COLOR_INSTANCE_TTY_SYMBOL (c)); | |
| 206 } | |
| 207 | |
| 208 static void | |
| 2286 | 209 tty_print_color_instance (Lisp_Color_Instance *UNUSED (c), |
| 210 Lisp_Object UNUSED (printcharfun), | |
| 211 int UNUSED (escapeflag)) | |
| 428 | 212 { |
| 213 } | |
| 214 | |
| 215 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
|
216 tty_finalize_color_instance (Lisp_Color_Instance *UNUSED_IF_NEW_GC (c)) |
| 428 | 217 { |
| 4141 | 218 #ifndef NEW_GC |
| 428 | 219 if (c->data) |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
220 { |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
221 xfree (c->data); |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
222 c->data = 0; |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
223 } |
| 4141 | 224 #endif /* not NEW_GC */ |
| 4117 | 225 } |
| 428 | 226 |
| 227 static int | |
| 440 | 228 tty_color_instance_equal (Lisp_Color_Instance *c1, |
| 229 Lisp_Color_Instance *c2, | |
| 2286 | 230 int UNUSED (depth)) |
| 428 | 231 { |
| 232 return (EQ (COLOR_INSTANCE_TTY_SYMBOL (c1), | |
| 233 COLOR_INSTANCE_TTY_SYMBOL (c2))); | |
| 234 } | |
| 235 | |
| 2515 | 236 static Hashcode |
| 2286 | 237 tty_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth)) |
| 428 | 238 { |
| 239 return LISP_HASH (COLOR_INSTANCE_TTY_SYMBOL (c)); | |
| 240 } | |
| 241 | |
| 242 static int | |
| 2286 | 243 tty_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color) |
| 428 | 244 { |
| 245 return (!NILP (assoc_no_quit (Fintern (color, Qnil), Vtty_color_alist))); | |
| 246 #if 0 | |
| 247 || STRINGP (Vtty_dynamic_color_fg) | |
| 248 || STRINGP (Vtty_dynamic_color_bg) | |
| 249 #endif | |
| 250 } | |
| 251 | |
| 252 | |
| 253 static int | |
| 440 | 254 tty_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name, |
| 2286 | 255 Lisp_Object UNUSED (device), |
| 256 Error_Behavior UNUSED (errb)) | |
| 428 | 257 { |
| 867 | 258 Ibyte *str = XSTRING_DATA (name); |
| 428 | 259 Lisp_Object charset = Qnil; |
| 260 | |
| 2367 | 261 if (qxestrncmp_ascii (str, "normal", 6)) |
| 428 | 262 return 0; |
| 263 str += 6; | |
| 264 if (*str) | |
| 265 { | |
| 266 #ifdef MULE | |
| 267 if (*str != '/') | |
| 268 return 0; | |
| 269 str++; | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
270 charset = Ffind_charset (intern_istring (str)); |
| 428 | 271 if (NILP (charset)) |
| 272 return 0; | |
| 273 #else | |
| 274 return 0; | |
| 275 #endif | |
| 276 } | |
| 277 | |
| 278 /* Don't allocate the data until we're sure that we will succeed. */ | |
| 3092 | 279 #ifdef NEW_GC |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
280 f->data = |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
281 XTTY_FONT_INSTANCE_DATA (ALLOC_NORMAL_LISP_OBJECT (tty_font_instance_data)); |
| 3092 | 282 #else /* not NEW_GC */ |
| 428 | 283 f->data = xnew (struct tty_font_instance_data); |
| 3092 | 284 #endif /* not NEW_GC */ |
| 428 | 285 FONT_INSTANCE_TTY_CHARSET (f) = charset; |
| 286 #ifdef MULE | |
| 287 if (CHARSETP (charset)) | |
| 288 f->width = XCHARSET_COLUMNS (charset); | |
| 289 else | |
| 290 #endif | |
| 291 f->width = 1; | |
| 292 | |
| 293 f->proportional_p = 0; | |
| 294 f->ascent = f->height = 1; | |
| 295 f->descent = 0; | |
| 296 | |
| 297 return 1; | |
| 298 } | |
| 299 | |
| 300 static void | |
| 440 | 301 tty_mark_font_instance (Lisp_Font_Instance *f) |
| 428 | 302 { |
| 303 mark_object (FONT_INSTANCE_TTY_CHARSET (f)); | |
| 304 } | |
| 305 | |
| 306 static void | |
| 2286 | 307 tty_print_font_instance (Lisp_Font_Instance *UNUSED (f), |
| 308 Lisp_Object UNUSED (printcharfun), | |
| 309 int UNUSED (escapeflag)) | |
| 428 | 310 { |
| 311 } | |
| 312 | |
| 313 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
|
314 tty_finalize_font_instance (Lisp_Font_Instance *UNUSED_IF_NEW_GC (f)) |
| 428 | 315 { |
| 4141 | 316 #ifndef NEW_GC |
| 428 | 317 if (f->data) |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
318 { |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
319 xfree (f->data); |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
320 f->data = 0; |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
321 } |
| 4141 | 322 #endif /* not NEW_GC */ |
| 4117 | 323 } |
| 428 | 324 |
| 325 static Lisp_Object | |
| 2527 | 326 tty_font_list (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device), |
| 2286 | 327 Lisp_Object UNUSED (maxnumber)) |
| 428 | 328 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
329 return list1 (build_ascstring ("normal")); |
| 428 | 330 } |
| 331 | |
| 332 #ifdef MULE | |
| 333 | |
| 334 static int | |
| 2286 | 335 tty_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset, |
| 867 | 336 const Ibyte *nonreloc, Lisp_Object reloc, |
| 872 | 337 Bytecount offset, Bytecount length, |
| 3841 | 338 enum font_specifier_matchspec_stages stage) |
| 428 | 339 { |
| 867 | 340 const Ibyte *the_nonreloc = nonreloc; |
| 428 | 341 |
|
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
342 if (stage == STAGE_FINAL) |
| 872 | 343 return 0; |
| 344 | |
| 428 | 345 if (!the_nonreloc) |
| 346 the_nonreloc = XSTRING_DATA (reloc); | |
| 347 fixup_internal_substring (nonreloc, reloc, offset, &length); | |
| 348 the_nonreloc += offset; | |
| 349 | |
|
4353
4143b78d0df0
Merge an old patch of Ben's, involving font instantiation and charsets.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
350 if (NILP (charset)) |
| 428 | 351 return !memchr (the_nonreloc, '/', length); |
| 867 | 352 the_nonreloc = (const Ibyte *) memchr (the_nonreloc, '/', length); |
| 428 | 353 if (!the_nonreloc) |
| 354 return 0; | |
| 355 the_nonreloc++; | |
| 356 { | |
| 793 | 357 Lisp_Object s = symbol_name (XSYMBOL (XCHARSET_NAME (charset))); |
| 358 return !qxestrcmp (the_nonreloc, XSTRING_DATA (s)); | |
| 428 | 359 } |
| 360 } | |
| 361 | |
| 362 /* find a font spec that matches font spec FONT and also matches | |
| 363 (the registry of) CHARSET. */ | |
| 364 static Lisp_Object | |
| 365 tty_find_charset_font (Lisp_Object device, Lisp_Object font, | |
| 3659 | 366 Lisp_Object charset, |
| 367 enum font_specifier_matchspec_stages stage) | |
| 428 | 368 { |
| 867 | 369 Ibyte *fontname = XSTRING_DATA (font); |
| 428 | 370 |
|
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
371 if (stage == STAGE_FINAL) |
| 872 | 372 return Qnil; |
| 373 | |
| 442 | 374 if (strchr ((const char *) fontname, '/')) |
| 428 | 375 { |
| 376 if (tty_font_spec_matches_charset (XDEVICE (device), charset, 0, | |
|
5015
d95c102a96d3
cleanups for specifier font stages, from ben-unicode-internal (preparation for eliminating shadowed warnings)
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
377 font, 0, -1, STAGE_INITIAL)) |
| 428 | 378 return font; |
| 379 return Qnil; | |
| 380 } | |
| 381 | |
|
4353
4143b78d0df0
Merge an old patch of Ben's, involving font instantiation and charsets.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
382 if (NILP (charset)) |
| 428 | 383 return font; |
| 384 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
385 return concat3 (font, build_ascstring ("/"), |
| 428 | 386 Fsymbol_name (XCHARSET_NAME (charset))); |
| 387 } | |
| 388 | |
| 389 #endif /* MULE */ | |
| 390 | |
| 391 | |
| 392 /************************************************************************/ | |
| 393 /* initialization */ | |
| 394 /************************************************************************/ | |
| 395 | |
| 396 void | |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5046
diff
changeset
|
397 syms_of_fontcolor_tty (void) |
| 428 | 398 { |
| 3092 | 399 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4710
diff
changeset
|
400 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
|
401 INIT_LISP_OBJECT (tty_font_instance_data); |
| 3092 | 402 #endif /* NEW_GC */ |
| 403 | |
| 428 | 404 DEFSUBR (Fregister_tty_color); |
| 405 DEFSUBR (Funregister_tty_color); | |
| 406 DEFSUBR (Ffind_tty_color); | |
| 407 #if 0 | |
| 408 DEFSUBR (Fset_tty_dynamic_color_specs); | |
| 409 DEFSUBR (Ftty_dynamic_color_specs); | |
| 410 #endif | |
| 411 } | |
| 412 | |
| 413 void | |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5046
diff
changeset
|
414 console_type_create_fontcolor_tty (void) |
| 428 | 415 { |
| 416 /* object methods */ | |
| 417 CONSOLE_HAS_METHOD (tty, initialize_color_instance); | |
| 418 CONSOLE_HAS_METHOD (tty, mark_color_instance); | |
| 419 CONSOLE_HAS_METHOD (tty, print_color_instance); | |
| 420 CONSOLE_HAS_METHOD (tty, finalize_color_instance); | |
| 421 CONSOLE_HAS_METHOD (tty, color_instance_equal); | |
| 422 CONSOLE_HAS_METHOD (tty, color_instance_hash); | |
| 423 CONSOLE_HAS_METHOD (tty, valid_color_name_p); | |
| 2527 | 424 CONSOLE_HAS_METHOD (tty, color_list); |
| 428 | 425 |
| 426 CONSOLE_HAS_METHOD (tty, initialize_font_instance); | |
| 427 CONSOLE_HAS_METHOD (tty, mark_font_instance); | |
| 428 CONSOLE_HAS_METHOD (tty, print_font_instance); | |
| 429 CONSOLE_HAS_METHOD (tty, finalize_font_instance); | |
| 2527 | 430 CONSOLE_HAS_METHOD (tty, font_list); |
| 428 | 431 #ifdef MULE |
| 432 CONSOLE_HAS_METHOD (tty, font_spec_matches_charset); | |
| 433 CONSOLE_HAS_METHOD (tty, find_charset_font); | |
| 434 #endif | |
| 435 } | |
| 436 | |
| 437 void | |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
5046
diff
changeset
|
438 vars_of_fontcolor_tty (void) |
| 428 | 439 { |
| 440 staticpro (&Vtty_color_alist); | |
| 441 Vtty_color_alist = Qnil; | |
| 442 | |
| 443 #if 0 | |
| 444 staticpro (&Vtty_dynamic_color_fg); | |
| 445 Vtty_dynamic_color_fg = Qnil; | |
| 446 | |
| 447 staticpro (&Vtty_dynamic_color_bg); | |
| 448 Vtty_dynamic_color_bg = Qnil; | |
| 449 #endif | |
| 450 } |