Mercurial > hg > xemacs-beta

comparison src/fontcolor-tty.c @ 5176:8b2f75cecb89

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
rename objects* (.c, .h and .el files) to fontcolor* -------------------- ChangeLog entries follow: -------------------- etc/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * dbxrc.in: Rename objects.c -> fontcolor.c. lisp/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * dumped-lisp.el (preloaded-file-list): * font.el (font-tty-find-closest-color): * fontcolor.el: * fontcolor.el (ws-object-property-1): Removed. * fontcolor.el (fontcolor-property-1): New. * fontcolor.el (font-name): * fontcolor.el (font-ascent): * fontcolor.el (font-descent): * fontcolor.el (font-width): * fontcolor.el (font-height): * fontcolor.el (font-proportional-p): * fontcolor.el (font-properties): * fontcolor.el (font-truename): * fontcolor.el (color-name): * fontcolor.el (color-rgb-components): * x-faces.el: Rename objects.el -> fontcolor.el. lwlib/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * lwlib-colors.h: objects*.h -> fontcolor*.h. man/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * internals/internals.texi (A Summary of the Various XEmacs Modules): * internals/internals.texi (Modules for other Display-Related Lisp Objects): objects*.[ch] -> fontcolor*.[ch]. nt/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * xemacs.dsp: * xemacs.mak: * xemacs.mak (OPT_OBJS): objects*.[ch] -> fontcolor*.[ch]. src/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * EmacsFrame.c: * Makefile.in.in (x_objs): * Makefile.in.in (mswindows_objs): * Makefile.in.in (tty_objs): * Makefile.in.in (gtk_objs): * Makefile.in.in (objs): * console-tty.h: * console-x-impl.h: * console-x-impl.h (struct x_device): * console-x.h: * console-xlike-inc.h: * depend: * device-gtk.c: * device-msw.c: * device-x.c: * device-x.c (x_init_device): * device-x.c (x_finish_init_device): * device.c: * devslots.h (MARKED_SLOT): * emacs.c (main_1): * event-Xt.c: * event-gtk.c: * event-msw.c: * faces.c: * font-mgr.c: * fontcolor-gtk-impl.h: * fontcolor-gtk.c: * fontcolor-gtk.c (syms_of_fontcolor_gtk): * fontcolor-gtk.c (console_type_create_fontcolor_gtk): * fontcolor-gtk.c (vars_of_fontcolor_gtk): * fontcolor-gtk.h: * fontcolor-impl.h: * fontcolor-msw-impl.h: * fontcolor-msw.c: * fontcolor-msw.c (syms_of_fontcolor_mswindows): * fontcolor-msw.c (console_type_create_fontcolor_mswindows): * fontcolor-msw.c (reinit_vars_of_fontcolor_mswindows): * fontcolor-msw.c (vars_of_fontcolor_mswindows): * fontcolor-msw.h: * fontcolor-msw.h (mswindows_color_to_string): * fontcolor-tty-impl.h: * fontcolor-tty.c: * fontcolor-tty.c (syms_of_fontcolor_tty): * fontcolor-tty.c (console_type_create_fontcolor_tty): * fontcolor-tty.c (vars_of_fontcolor_tty): * fontcolor-tty.h: * fontcolor-x-impl.h: * fontcolor-x.c: * fontcolor-x.c (syms_of_fontcolor_x): * fontcolor-x.c (console_type_create_fontcolor_x): * fontcolor-x.c (vars_of_fontcolor_x): * fontcolor-x.c (Xatoms_of_fontcolor_x): * fontcolor-x.h: * fontcolor.c: * fontcolor.c (syms_of_fontcolor): * fontcolor.c (specifier_type_create_fontcolor): * fontcolor.c (reinit_specifier_type_create_fontcolor): * fontcolor.c (reinit_vars_of_fontcolor): * fontcolor.c (vars_of_fontcolor): * fontcolor.h: * fontcolor.h (set_face_boolean_attached_to): * frame-gtk.c: * frame-x.c: * glyphs-eimage.c: * glyphs-gtk.c: * glyphs-msw.c: * glyphs-widget.c: * glyphs-x.c: * glyphs.c: * gtk-glue.c: * gtk-glue.c (xemacs_type_register): * gtk-xemacs.c: * inline.c: * intl-win32.c: * lisp.h: * lrecord.h: * mule-charset.c: * native-gtk-toolbar.c: * redisplay-msw.c: * redisplay-tty.c: * redisplay.c: * select-x.c: * select.c: * symsinit.h: * toolbar-msw.c: * toolbar-msw.c (TOOLBAR_ITEM_ID_BITS): * toolbar-x.c: * ui-gtk.c: * window.c: Rename objects*.[ch] -> fontcolor*.[ch]. Fix up all references to the old files (e.g. in #include statements, Makefiles, functions like syms_of_objects_x(), etc.). tests/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * reproduce-crashes.el (8): objects*.[ch] -> fontcolor*.[ch].
author Ben Wing <ben@xemacs.org>
date Mon, 22 Feb 2010 06:49:30 -0600
parents src/objects-tty.c@d4f666cda5e6
children 97eb4942aec8
comparison
equal deleted inserted replaced
5175:dc94bf0afa37 5176:8b2f75cecb89
1 /* TTY-specific Lisp objects.
2 Copyright (C) 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1995, 1996, 2001, 2002, 2010 Ben Wing.
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
27 #include "console-tty-impl.h"
28 #include "insdel.h"
29 #include "fontcolor-tty-impl.h"
30 #include "device.h"
31 #include "charset.h"
32
33 /* An alist mapping from color names to a cons of (FG-STRING, BG-STRING). */
34 Lisp_Object Vtty_color_alist;
35 #if 0 /* This stuff doesn't quite work yet */
36 Lisp_Object Vtty_dynamic_color_fg;
37 Lisp_Object Vtty_dynamic_color_bg;
38 #endif
39
40 static const struct memory_description tty_color_instance_data_description_1 [] = {
41 { XD_LISP_OBJECT, offsetof (struct tty_color_instance_data, symbol) },
42 { XD_END }
43 };
44
45 #ifdef NEW_GC
46 DEFINE_LRECORD_IMPLEMENTATION ("tty-color-instance-data",
47 tty_color_instance_data,
48 0, /*dumpable-flag*/
49 0, 0, 0, 0, 0,
50 tty_color_instance_data_description_1,
51 struct tty_color_instance_data);
52 #else /* not NEW_GC */
53 const struct sized_memory_description tty_color_instance_data_description = {
54 sizeof (struct tty_color_instance_data), tty_color_instance_data_description_1
55 };
56 #endif /* not NEW_GC */
57
58 static const struct memory_description tty_font_instance_data_description_1 [] = {
59 { XD_LISP_OBJECT, offsetof (struct tty_font_instance_data, charset) },
60 { XD_END }
61 };
62
63 #ifdef NEW_GC
64 DEFINE_LRECORD_IMPLEMENTATION ("tty-font-instance-data",
65 tty_font_instance_data,
66 0, /*dumpable-flag*/
67 0, 0, 0, 0, 0,
68 tty_font_instance_data_description_1,
69 struct tty_font_instance_data);
70 #else /* not NEW_GC */
71 const struct sized_memory_description tty_font_instance_data_description = {
72 sizeof (struct tty_font_instance_data), tty_font_instance_data_description_1
73 };
74 #endif /* not NEW_GC */
75
76 DEFUN ("register-tty-color", Fregister_tty_color, 3, 3, 0, /*
77 Register COLOR as a recognized TTY color.
78 COLOR should be a string.
79 Strings FG-STRING and BG-STRING should specify the escape sequences to
80 set the foreground and background to the given color, respectively.
81 */
82 (color, fg_string, bg_string))
83 {
84 CHECK_STRING (color);
85 CHECK_STRING (fg_string);
86 CHECK_STRING (bg_string);
87
88 color = Fintern (color, Qnil);
89 Vtty_color_alist = Fremassq (color, Vtty_color_alist);
90 Vtty_color_alist = Fcons (Fcons (color, Fcons (fg_string, bg_string)),
91 Vtty_color_alist);
92
93 return Qnil;
94 }
95
96 DEFUN ("unregister-tty-color", Funregister_tty_color, 1, 1, 0, /*
97 Unregister COLOR as a recognized TTY color.
98 */
99 (color))
100 {
101 CHECK_STRING (color);
102
103 color = Fintern (color, Qnil);
104 Vtty_color_alist = Fremassq (color, Vtty_color_alist);
105 return Qnil;
106 }
107
108 DEFUN ("find-tty-color", Ffind_tty_color, 1, 1, 0, /*
109 Look up COLOR in the list of registered TTY colors.
110 If it is found, return a list (FG-STRING BG-STRING) of the escape
111 sequences used to set the foreground and background to the color, respectively.
112 If it is not found, return nil.
113 */
114 (color))
115 {
116 Lisp_Object result;
117
118 CHECK_STRING (color);
119
120 result = Fassq (Fintern (color, Qnil), Vtty_color_alist);
121 if (!NILP (result))
122 return list2 (Fcar (Fcdr (result)), Fcdr (Fcdr (result)));
123 else
124 return Qnil;
125 }
126
127 static Lisp_Object
128 tty_color_list (void)
129 {
130 Lisp_Object result = Qnil;
131 Lisp_Object rest;
132
133 LIST_LOOP (rest, Vtty_color_alist)
134 {
135 result = Fcons (Fsymbol_name (XCAR (XCAR (rest))), result);
136 }
137
138 return Fnreverse (result);
139 }
140
141 #if 0
142
143 /* This approach is too simplistic. The problem is that the
144 dynamic color settings apply to *all* text in the default color,
145 not just the text output after the escape sequence has been given. */
146
147 DEFUN ("set-tty-dynamic-color-specs", Fset_tty_dynamic_color_specs, 2, 2, 0, /*
148 Set the dynamic color specifications for TTY's.
149 FG and BG should be either nil or vaguely printf-like strings,
150 where each occurrence of %s is replaced with the color name and each
151 occurrence of %% is replaced with a single % character.
152 */
153 (fg, bg))
154 {
155 if (!NILP (fg))
156 CHECK_STRING (fg);
157 if (!NILP (bg))
158 CHECK_STRING (bg);
159
160 Vtty_dynamic_color_fg = fg;
161 Vtty_dynamic_color_bg = bg;
162
163 return Qnil;
164 }
165
166 DEFUN ("tty-dynamic-color-specs", Ftty_dynamic_color_specs, 0, 0, 0, /*
167 Return the dynamic color specifications for TTY's as a list of (FG BG).
168 See `set-tty-dynamic-color-specs'.
169 */
170 ())
171 {
172 return list2 (Vtty_dynamic_color_fg, Vtty_dynamic_color_bg);
173 }
174
175 #endif /* 0 */
176
177 static int
178 tty_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name,
179 Lisp_Object UNUSED (device),
180 Error_Behavior UNUSED (errb))
181 {
182 Lisp_Object result;
183
184 name = Fintern (name, Qnil);
185 result = assq_no_quit (name, Vtty_color_alist);
186
187 if (NILP (result))
188 {
189 #if 0
190 if (!STRINGP (Vtty_dynamic_color_fg)
191 && !STRINGP (Vtty_dynamic_color_bg))
192 #endif
193 return 0;
194 }
195
196 /* Don't allocate the data until we're sure that we will succeed. */
197 #ifdef NEW_GC
198 c->data = alloc_lrecord_type (struct tty_color_instance_data,
199 &lrecord_tty_color_instance_data);
200 #else /* not NEW_GC */
201 c->data = xnew (struct tty_color_instance_data);
202 #endif /* not NEW_GC */
203 COLOR_INSTANCE_TTY_SYMBOL (c) = name;
204
205 return 1;
206 }
207
208 static void
209 tty_mark_color_instance (Lisp_Color_Instance *c)
210 {
211 mark_object (COLOR_INSTANCE_TTY_SYMBOL (c));
212 }
213
214 static void
215 tty_print_color_instance (Lisp_Color_Instance *UNUSED (c),
216 Lisp_Object UNUSED (printcharfun),
217 int UNUSED (escapeflag))
218 {
219 }
220
221 static void
222 tty_finalize_color_instance (Lisp_Color_Instance *UNUSED_IF_NEW_GC (c))
223 {
224 #ifndef NEW_GC
225 if (c->data)
226 xfree (c->data);
227 #endif /* not NEW_GC */
228 }
229
230 static int
231 tty_color_instance_equal (Lisp_Color_Instance *c1,
232 Lisp_Color_Instance *c2,
233 int UNUSED (depth))
234 {
235 return (EQ (COLOR_INSTANCE_TTY_SYMBOL (c1),
236 COLOR_INSTANCE_TTY_SYMBOL (c2)));
237 }
238
239 static Hashcode
240 tty_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth))
241 {
242 return LISP_HASH (COLOR_INSTANCE_TTY_SYMBOL (c));
243 }
244
245 static int
246 tty_valid_color_name_p (struct device *UNUSED (d), Lisp_Object color)
247 {
248 return (!NILP (assoc_no_quit (Fintern (color, Qnil), Vtty_color_alist)));
249 #if 0
250 || STRINGP (Vtty_dynamic_color_fg)
251 || STRINGP (Vtty_dynamic_color_bg)
252 #endif
253 }
254
255
256 static int
257 tty_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name,
258 Lisp_Object UNUSED (device),
259 Error_Behavior UNUSED (errb))
260 {
261 Ibyte *str = XSTRING_DATA (name);
262 Lisp_Object charset = Qnil;
263
264 if (qxestrncmp_ascii (str, "normal", 6))
265 return 0;
266 str += 6;
267 if (*str)
268 {
269 #ifdef MULE
270 if (*str != '/')
271 return 0;
272 str++;
273 charset = Ffind_charset (intern_istring (str));
274 if (NILP (charset))
275 return 0;
276 #else
277 return 0;
278 #endif
279 }
280
281 /* Don't allocate the data until we're sure that we will succeed. */
282 #ifdef NEW_GC
283 f->data = alloc_lrecord_type (struct tty_font_instance_data,
284 &lrecord_tty_font_instance_data);
285 #else /* not NEW_GC */
286 f->data = xnew (struct tty_font_instance_data);
287 #endif /* not NEW_GC */
288 FONT_INSTANCE_TTY_CHARSET (f) = charset;
289 #ifdef MULE
290 if (CHARSETP (charset))
291 f->width = XCHARSET_COLUMNS (charset);
292 else
293 #endif
294 f->width = 1;
295
296 f->proportional_p = 0;
297 f->ascent = f->height = 1;
298 f->descent = 0;
299
300 return 1;
301 }
302
303 static void
304 tty_mark_font_instance (Lisp_Font_Instance *f)
305 {
306 mark_object (FONT_INSTANCE_TTY_CHARSET (f));
307 }
308
309 static void
310 tty_print_font_instance (Lisp_Font_Instance *UNUSED (f),
311 Lisp_Object UNUSED (printcharfun),
312 int UNUSED (escapeflag))
313 {
314 }
315
316 static void
317 tty_finalize_font_instance (Lisp_Font_Instance *UNUSED_IF_NEW_GC (f))
318 {
319 #ifndef NEW_GC
320 if (f->data)
321 xfree (f->data);
322 #endif /* not NEW_GC */
323 }
324
325 static Lisp_Object
326 tty_font_list (Lisp_Object UNUSED (pattern), Lisp_Object UNUSED (device),
327 Lisp_Object UNUSED (maxnumber))
328 {
329 return list1 (build_ascstring ("normal"));
330 }
331
332 #ifdef MULE
333
334 static int
335 tty_font_spec_matches_charset (struct device *UNUSED (d), Lisp_Object charset,
336 const Ibyte *nonreloc, Lisp_Object reloc,
337 Bytecount offset, Bytecount length,
338 enum font_specifier_matchspec_stages stage)
339 {
340 const Ibyte *the_nonreloc = nonreloc;
341
342 if (stage == STAGE_FINAL)
343 return 0;
344
345 if (!the_nonreloc)
346 the_nonreloc = XSTRING_DATA (reloc);
347 fixup_internal_substring (nonreloc, reloc, offset, &length);
348 the_nonreloc += offset;
349
350 if (NILP (charset))
351 return !memchr (the_nonreloc, '/', length);
352 the_nonreloc = (const Ibyte *) memchr (the_nonreloc, '/', length);
353 if (!the_nonreloc)
354 return 0;
355 the_nonreloc++;
356 {
357 Lisp_Object s = symbol_name (XSYMBOL (XCHARSET_NAME (charset)));
358 return !qxestrcmp (the_nonreloc, XSTRING_DATA (s));
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,
366 Lisp_Object charset,
367 enum font_specifier_matchspec_stages stage)
368 {
369 Ibyte *fontname = XSTRING_DATA (font);
370
371 if (stage == STAGE_FINAL)
372 return Qnil;
373
374 if (strchr ((const char *) fontname, '/'))
375 {
376 if (tty_font_spec_matches_charset (XDEVICE (device), charset, 0,
377 font, 0, -1, STAGE_INITIAL))
378 return font;
379 return Qnil;
380 }
381
382 if (NILP (charset))
383 return font;
384
385 return concat3 (font, build_ascstring ("/"),
386 Fsymbol_name (XCHARSET_NAME (charset)));
387 }
388
389 #endif /* MULE */
390
391
392 /************************************************************************/
393 /* initialization */
394 /************************************************************************/
395
396 void
397 syms_of_fontcolor_tty (void)
398 {
399 #ifdef NEW_GC
400 INIT_LRECORD_IMPLEMENTATION (tty_color_instance_data);
401 INIT_LRECORD_IMPLEMENTATION (tty_font_instance_data);
402 #endif /* NEW_GC */
403
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
414 console_type_create_fontcolor_tty (void)
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);
424 CONSOLE_HAS_METHOD (tty, color_list);
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);
430 CONSOLE_HAS_METHOD (tty, font_list);
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
438 vars_of_fontcolor_tty (void)
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 }