comparison src/console.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
51 in this structure as an individual console's value occupies in 51 in this structure as an individual console's value occupies in
52 that console. Setting the default value also goes through the 52 that console. Setting the default value also goes through the
53 list of consoles and stores into each console that does not say 53 list of consoles and stores into each console that does not say
54 it has a local value. */ 54 it has a local value. */
55 Lisp_Object Vconsole_defaults; 55 Lisp_Object Vconsole_defaults;
56 static void *console_defaults_saved_slots;
56 57
57 /* This structure marks which slots in a console have corresponding 58 /* This structure marks which slots in a console have corresponding
58 default values in console_defaults. 59 default values in console_defaults.
59 Each such slot has a nonzero value in this structure. 60 Each such slot has a nonzero value in this structure.
60 The value has only one nonzero bit. 61 The value has only one nonzero bit.
67 for the slot, but there is no default value for it; the corresponding 68 for the slot, but there is no default value for it; the corresponding
68 slot in console_defaults is not used except to initialize newly-created 69 slot in console_defaults is not used except to initialize newly-created
69 consoles. 70 consoles.
70 71
71 If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it 72 If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it
72 as well as a default value which is used to initialize newly-created 73 as well as a default value which is used to initialize newly-created
73 consoles and as a reset-value when local-vars are killed. 74 consoles and as a reset-value when local-vars are killed.
74 75
75 If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it. 76 If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it.
76 (The slot is always local, but there's no lisp variable for it.) 77 (The slot is always local, but there's no lisp variable for it.)
77 The default value is only used to initialize newly-creation consoles. 78 The default value is only used to initialize newly-creation consoles.
85 struct console console_local_flags; 86 struct console console_local_flags;
86 87
87 /* This structure holds the names of symbols whose values may be 88 /* This structure holds the names of symbols whose values may be
88 console-local. It is indexed and accessed in the same way as the above. */ 89 console-local. It is indexed and accessed in the same way as the above. */
89 static Lisp_Object Vconsole_local_symbols; 90 static Lisp_Object Vconsole_local_symbols;
91 static void *console_local_symbols_saved_slots;
90 92
91 DEFINE_CONSOLE_TYPE (dead); 93 DEFINE_CONSOLE_TYPE (dead);
92 94
93 Lisp_Object Vconsole_type_list; 95 Lisp_Object Vconsole_type_list;
94 96
95 console_type_entry_dynarr *the_console_type_entry_dynarr; 97 console_type_entry_dynarr *the_console_type_entry_dynarr;
96 98
97 99
98 static Lisp_Object 100 static Lisp_Object
99 mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object)) 101 mark_console (Lisp_Object obj)
100 { 102 {
101 struct console *con = XCONSOLE (obj); 103 struct console *con = XCONSOLE (obj);
102 104
103 #define MARKED_SLOT(x) ((void) (markobj (con->x))); 105 #define MARKED_SLOT(x) mark_object (con->x)
104 #include "conslots.h" 106 #include "conslots.h"
105 #undef MARKED_SLOT 107 #undef MARKED_SLOT
106 108
107 /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */ 109 /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */
108 if (con->conmeths) 110 if (con->conmeths)
109 { 111 {
110 markobj (con->conmeths->symbol); 112 mark_object (con->conmeths->symbol);
111 MAYBE_CONMETH (con, mark_console, (con, markobj)); 113 MAYBE_CONMETH (con, mark_console, (con));
112 } 114 }
113 115
114 return Qnil; 116 return Qnil;
115 } 117 }
116 118
125 XSTRING_DATA (con->name), con->header.uid); 127 XSTRING_DATA (con->name), con->header.uid);
126 128
127 sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" : 129 sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" :
128 CONSOLE_TYPE_NAME (con)); 130 CONSOLE_TYPE_NAME (con));
129 write_c_string (buf, printcharfun); 131 write_c_string (buf, printcharfun);
130 if (CONSOLE_LIVE_P (con)) 132 if (CONSOLE_LIVE_P (con) && !NILP (CONSOLE_CONNECTION (con)))
131 { 133 {
132 write_c_string (" on ", printcharfun); 134 write_c_string (" on ", printcharfun);
133 print_internal (CONSOLE_CONNECTION (con), printcharfun, 1); 135 print_internal (CONSOLE_CONNECTION (con), printcharfun, 1);
134 } 136 }
135 sprintf (buf, " 0x%x>", con->header.uid); 137 sprintf (buf, " 0x%x>", con->header.uid);
136 write_c_string (buf, printcharfun); 138 write_c_string (buf, printcharfun);
137 } 139 }
138 140
139 DEFINE_LRECORD_IMPLEMENTATION ("console", console, 141 DEFINE_LRECORD_IMPLEMENTATION ("console", console,
140 mark_console, print_console, 0, 0, 0, 142 mark_console, print_console, 0, 0, 0, 0,
141 struct console); 143 struct console);
142 144
143 static struct console * 145 static struct console *
144 allocate_console (void) 146 allocate_console (void)
145 { 147 {
146 Lisp_Object console; 148 Lisp_Object console;
147 struct console *con = alloc_lcrecord_type (struct console, lrecord_console); 149 struct console *con = alloc_lcrecord_type (struct console, &lrecord_console);
148 struct gcpro gcpro1; 150 struct gcpro gcpro1;
149 151
150 copy_lcrecord (con, XCONSOLE (Vconsole_defaults)); 152 copy_lcrecord (con, XCONSOLE (Vconsole_defaults));
151 153
152 XSETCONSOLE (console, con); 154 XSETCONSOLE (console, con);
351 353
352 static Lisp_Object 354 static Lisp_Object
353 semi_canonicalize_console_connection (struct console_methods *meths, 355 semi_canonicalize_console_connection (struct console_methods *meths,
354 Lisp_Object name, Error_behavior errb) 356 Lisp_Object name, Error_behavior errb)
355 { 357 {
356 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection, 358 if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_console_connection))
357 (name, errb), name); 359 return CONTYPE_METH (meths, semi_canonicalize_console_connection,
360 (name, errb));
361 else
362 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection,
363 (name, errb), name);
358 } 364 }
359 365
360 static Lisp_Object 366 static Lisp_Object
361 canonicalize_console_connection (struct console_methods *meths, 367 canonicalize_console_connection (struct console_methods *meths,
362 Lisp_Object name, Error_behavior errb) 368 Lisp_Object name, Error_behavior errb)
363 { 369 {
364 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection, 370 if (HAS_CONTYPE_METH_P (meths, canonicalize_console_connection))
365 (name, errb), name); 371 return CONTYPE_METH (meths, canonicalize_console_connection,
372 (name, errb));
373 else
374 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection,
375 (name, errb), name);
366 } 376 }
367 377
368 static Lisp_Object 378 static Lisp_Object
369 find_console_of_type (struct console_methods *meths, Lisp_Object canon) 379 find_console_of_type (struct console_methods *meths, Lisp_Object canon)
370 { 380 {
484 MAYBE_CONMETH (con, init_console, (con, props)); 494 MAYBE_CONMETH (con, init_console, (con, props));
485 495
486 /* Do it this way so that the console list is in order of creation */ 496 /* Do it this way so that the console list is in order of creation */
487 Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil)); 497 Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil));
488 498
489 if (CONMETH (con, initially_selected_for_input, (con))) 499 if (CONMETH_OR_GIVEN (con, initially_selected_for_input, (con), 0))
490 event_stream_select_console (con); 500 event_stream_select_console (con);
491 501
492 UNGCPRO; 502 UNGCPRO;
493 return console; 503 return console;
494 } 504 }
874 if (STRINGP (stuffstring)) 884 if (STRINGP (stuffstring))
875 { 885 {
876 Extcount count; 886 Extcount count;
877 Extbyte *p; 887 Extbyte *p;
878 888
879 GET_STRING_EXT_DATA_ALLOCA (stuffstring, FORMAT_KEYBOARD, p, count); 889 TO_EXTERNAL_FORMAT (LISP_STRING, stuffstring,
890 ALLOCA, (p, count),
891 Qkeyboard);
880 while (count-- > 0) 892 while (count-- > 0)
881 stuff_char (XCONSOLE (Vcontrolling_terminal), *p++); 893 stuff_char (XCONSOLE (Vcontrolling_terminal), *p++);
882 stuff_char (XCONSOLE (Vcontrolling_terminal), '\n'); 894 stuff_char (XCONSOLE (Vcontrolling_terminal), '\n');
883 } 895 }
884 /* Anything we have read ahead, put back for the shell to read. */ 896 /* Anything we have read ahead, put back for the shell to read. */
1094 1106
1095 defsymbol (&Qsuspend_hook, "suspend-hook"); 1107 defsymbol (&Qsuspend_hook, "suspend-hook");
1096 defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook"); 1108 defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook");
1097 } 1109 }
1098 1110
1111 static const struct lrecord_description cte_description_1[] = {
1112 { XD_LISP_OBJECT, offsetof (console_type_entry, symbol) },
1113 { XD_STRUCT_PTR, offsetof (console_type_entry, meths), 1, &console_methods_description },
1114 { XD_END }
1115 };
1116
1117 static const struct struct_description cte_description = {
1118 sizeof (console_type_entry),
1119 cte_description_1
1120 };
1121
1122 static const struct lrecord_description cted_description_1[] = {
1123 XD_DYNARR_DESC (console_type_entry_dynarr, &cte_description),
1124 { XD_END }
1125 };
1126
1127 const struct struct_description cted_description = {
1128 sizeof (console_type_entry_dynarr),
1129 cted_description_1
1130 };
1131
1132 static const struct lrecord_description console_methods_description_1[] = {
1133 { XD_LISP_OBJECT, offsetof (struct console_methods, symbol) },
1134 { XD_LISP_OBJECT, offsetof (struct console_methods, predicate_symbol) },
1135 { XD_LISP_OBJECT, offsetof (struct console_methods, image_conversion_list) },
1136 { XD_END }
1137 };
1138
1139 const struct struct_description console_methods_description = {
1140 sizeof (struct console_methods),
1141 console_methods_description_1
1142 };
1143
1144
1099 void 1145 void
1100 console_type_create (void) 1146 console_type_create (void)
1101 { 1147 {
1102 the_console_type_entry_dynarr = Dynarr_new (console_type_entry); 1148 the_console_type_entry_dynarr = Dynarr_new (console_type_entry);
1149 dumpstruct(&the_console_type_entry_dynarr, &cted_description);
1103 1150
1104 Vconsole_type_list = Qnil; 1151 Vconsole_type_list = Qnil;
1105 staticpro (&Vconsole_type_list); 1152 staticpro (&Vconsole_type_list);
1106 1153
1107 /* Initialize the dead console type */ 1154 /* Initialize the dead console type */
1112 Dynarr_reset (the_console_type_entry_dynarr); 1159 Dynarr_reset (the_console_type_entry_dynarr);
1113 Vconsole_type_list = Qnil; 1160 Vconsole_type_list = Qnil;
1114 } 1161 }
1115 1162
1116 void 1163 void
1164 reinit_vars_of_console (void)
1165 {
1166 staticpro_nodump (&Vconsole_list);
1167 Vconsole_list = Qnil;
1168 staticpro_nodump (&Vselected_console);
1169 Vselected_console = Qnil;
1170 }
1171
1172 void
1117 vars_of_console (void) 1173 vars_of_console (void)
1118 { 1174 {
1175 reinit_vars_of_console ();
1176
1119 DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /* 1177 DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /*
1120 Function or functions to call when a console is created. 1178 Function or functions to call when a console is created.
1121 One argument, the newly-created console. 1179 One argument, the newly-created console.
1122 This is called after the first frame has been created, but before 1180 This is called after the first frame has been created, but before
1123 calling the `create-device-hook' or `create-frame-hook'. 1181 calling the `create-device-hook' or `create-frame-hook'.
1129 Function or functions to call when a console is deleted. 1187 Function or functions to call when a console is deleted.
1130 One argument, the to-be-deleted console. 1188 One argument, the to-be-deleted console.
1131 */ ); 1189 */ );
1132 Vdelete_console_hook = Qnil; 1190 Vdelete_console_hook = Qnil;
1133 1191
1134 staticpro (&Vconsole_list);
1135 Vconsole_list = Qnil;
1136 staticpro (&Vselected_console);
1137 Vselected_console = Qnil;
1138
1139 #ifdef HAVE_WINDOW_SYSTEM 1192 #ifdef HAVE_WINDOW_SYSTEM
1140 Fprovide (intern ("window-system")); 1193 Fprovide (intern ("window-system"));
1141 #endif 1194 #endif
1142 } 1195 }
1143 1196
1145 1198
1146 /* Declaring this stuff as const produces 'Cannot reinitialize' messages 1199 /* Declaring this stuff as const produces 'Cannot reinitialize' messages
1147 from SunPro C's fix-and-continue feature (a way neato feature that 1200 from SunPro C's fix-and-continue feature (a way neato feature that
1148 makes debugging unbelievably more bearable) */ 1201 makes debugging unbelievably more bearable) */
1149 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do { \ 1202 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do { \
1150 static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ 1203 static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C = \
1151 = { { { symbol_value_forward_lheader_initializer, \ 1204 { /* struct symbol_value_forward */ \
1152 (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ 1205 { /* struct symbol_value_magic */ \
1153 forward_type }, magicfun }; \ 1206 { /* struct lcrecord_header */ \
1207 { /* struct lrecord_header */ \
1208 1, /* type - index into lrecord_implementations_table */ \
1209 0, /* mark bit */ \
1210 0, /* c_readonly bit */ \
1211 0 /* lisp_readonly bit */ \
1212 }, \
1213 0, /* next */ \
1214 0, /* uid */ \
1215 0 /* free */ \
1216 }, \
1217 &(console_local_flags.field_name), \
1218 forward_type \
1219 }, \
1220 magicfun \
1221 }; \
1222 \
1154 { \ 1223 { \
1155 int offset = ((char *)symbol_value_forward_forward (&I_hate_C) \ 1224 int offset = ((char *)symbol_value_forward_forward (&I_hate_C) \
1156 - (char *)&console_local_flags); \ 1225 - (char *)&console_local_flags); \
1157 \ 1226 \
1158 defvar_magic (lname, &I_hate_C); \ 1227 defvar_magic (lname, &I_hate_C); \
1182 static void 1251 static void
1183 nuke_all_console_slots (struct console *con, Lisp_Object zap) 1252 nuke_all_console_slots (struct console *con, Lisp_Object zap)
1184 { 1253 {
1185 zero_lcrecord (con); 1254 zero_lcrecord (con);
1186 1255
1187 #define MARKED_SLOT(x) con->x = (zap); 1256 #define MARKED_SLOT(x) con->x = zap
1188 #include "conslots.h" 1257 #include "conslots.h"
1189 #undef MARKED_SLOT 1258 #undef MARKED_SLOT
1190 } 1259 }
1191 1260
1192 void 1261 static void
1193 complex_vars_of_console (void) 1262 common_init_complex_vars_of_console (void)
1194 { 1263 {
1195 /* Make sure all markable slots in console_defaults 1264 /* Make sure all markable slots in console_defaults
1196 are initialized reasonably, so mark_console won't choke. 1265 are initialized reasonably, so mark_console won't choke.
1197 */ 1266 */
1198 struct console *defs = alloc_lcrecord_type (struct console, lrecord_console); 1267 struct console *defs = alloc_lcrecord_type (struct console, &lrecord_console);
1199 struct console *syms = alloc_lcrecord_type (struct console, lrecord_console); 1268 struct console *syms = alloc_lcrecord_type (struct console, &lrecord_console);
1200 1269
1201 staticpro (&Vconsole_defaults); 1270 staticpro_nodump (&Vconsole_defaults);
1202 staticpro (&Vconsole_local_symbols); 1271 staticpro_nodump (&Vconsole_local_symbols);
1203 XSETCONSOLE (Vconsole_defaults, defs); 1272 XSETCONSOLE (Vconsole_defaults, defs);
1204 XSETCONSOLE (Vconsole_local_symbols, syms); 1273 XSETCONSOLE (Vconsole_local_symbols, syms);
1205 1274
1206 nuke_all_console_slots (syms, Qnil); 1275 nuke_all_console_slots (syms, Qnil);
1207 nuke_all_console_slots (defs, Qnil); 1276 nuke_all_console_slots (defs, Qnil);
1252 1321
1253 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number 1322 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
1254 currently allowable due to the XINT() handling of this value. 1323 currently allowable due to the XINT() handling of this value.
1255 With some rearrangement you can get 4 more bits. */ 1324 With some rearrangement you can get 4 more bits. */
1256 } 1325 }
1326 }
1327
1328
1329 #define CONSOLE_SLOTS_SIZE (offsetof (struct console, CONSOLE_SLOTS_LAST_NAME) - offsetof (struct console, CONSOLE_SLOTS_FIRST_NAME) + sizeof (Lisp_Object))
1330 #define CONSOLE_SLOTS_COUNT (CONSOLE_SLOTS_SIZE / sizeof (Lisp_Object))
1331
1332 void
1333 reinit_complex_vars_of_console (void)
1334 {
1335 struct console *defs, *syms;
1336
1337 common_init_complex_vars_of_console ();
1338
1339 defs = XCONSOLE (Vconsole_defaults);
1340 syms = XCONSOLE (Vconsole_local_symbols);
1341 memcpy (&defs->CONSOLE_SLOTS_FIRST_NAME,
1342 console_defaults_saved_slots,
1343 CONSOLE_SLOTS_SIZE);
1344 memcpy (&syms->CONSOLE_SLOTS_FIRST_NAME,
1345 console_local_symbols_saved_slots,
1346 CONSOLE_SLOTS_SIZE);
1347 }
1348
1349
1350 static const struct lrecord_description console_slots_description_1[] = {
1351 { XD_LISP_OBJECT_ARRAY, 0, CONSOLE_SLOTS_COUNT },
1352 { XD_END }
1353 };
1354
1355 static const struct struct_description console_slots_description = {
1356 CONSOLE_SLOTS_SIZE,
1357 console_slots_description_1
1358 };
1359
1360 void
1361 complex_vars_of_console (void)
1362 {
1363 struct console *defs, *syms;
1364
1365 common_init_complex_vars_of_console ();
1366
1367 defs = XCONSOLE (Vconsole_defaults);
1368 syms = XCONSOLE (Vconsole_local_symbols);
1369 console_defaults_saved_slots = &defs->CONSOLE_SLOTS_FIRST_NAME;
1370 console_local_symbols_saved_slots = &syms->CONSOLE_SLOTS_FIRST_NAME;
1371 dumpstruct (&console_defaults_saved_slots, &console_slots_description);
1372 dumpstruct (&console_local_symbols_saved_slots, &console_slots_description);
1257 1373
1258 DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /* 1374 DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /*
1259 Default value of `function-key-map' for consoles that don't override it. 1375 Default value of `function-key-map' for consoles that don't override it.
1260 This is the same as (default-value 'function-key-map). 1376 This is the same as (default-value 'function-key-map).
1261 */ ); 1377 */ );
1282 were a prefix key, typing `ESC O P x' would return 1398 were a prefix key, typing `ESC O P x' would return
1283 \[#<keypress-event f1> #<keypress-event x>]. 1399 \[#<keypress-event f1> #<keypress-event x>].
1284 */ ); 1400 */ );
1285 1401
1286 #ifdef HAVE_TTY 1402 #ifdef HAVE_TTY
1287 /* ### Should this somehow go to TTY data? How do we make it 1403 /* #### Should this somehow go to TTY data? How do we make it
1288 accessible from Lisp, then? */ 1404 accessible from Lisp, then? */
1289 DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /* 1405 DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /*
1290 The ERASE character as set by the user with stty. 1406 The ERASE character as set by the user with stty.
1291 When this value cannot be determined or would be meaningless (on non-TTY 1407 When this value cannot be determined or would be meaningless (on non-TTY
1292 consoles, for example), it is set to nil. 1408 consoles, for example), it is set to nil.
1293 */ ); 1409 */ );
1294 #endif 1410 #endif
1295 1411
1296 /* While this should be CONST it can't be because some things 1412 /* While this should be const it can't be because some things
1297 (i.e. edebug) do manipulate it. */ 1413 (i.e. edebug) do manipulate it. */
1298 DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /* 1414 DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /*
1299 Non-nil while a console macro is being defined. Don't set this! 1415 Non-nil while a console macro is being defined. Don't set this!
1300 */ ); 1416 */ );
1301 1417