cgit.sxemacs.org Git - sxemacs/blob - src/ui/console.c

   1 /* The console object.
   2    Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
   3    Copyright (C) 1996 Ben Wing.
   4
   5 This file is part of SXEmacs
   6
   7 SXEmacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 SXEmacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  19
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 /* Written by Ben Wing. */
  24
  25 #include <config.h>
  26 #include "lisp.h"
  27
  28 #include "buffer.h"
  29 #include "TTY/console-tty.h" /* for Fconsole_tty_controlling process ins
  30                                 suspend-console. Needs refactoring...*/
  31 #include "events/events.h"
  32 #include "frame.h"
  33 #include "redisplay.h"
  34 #include "sysdep.h"
  35 #include "window.h"
  36
  37 Lisp_Object Vconsole_list, Vselected_console;
  38
  39 Lisp_Object Vcreate_console_hook, Vdelete_console_hook;
  40
  41 Lisp_Object Qconsolep, Qconsole_live_p;
  42 Lisp_Object Qcreate_console_hook;
  43 Lisp_Object Qdelete_console_hook;
  44
  45 Lisp_Object Qsuspend_hook;
  46 Lisp_Object Qsuspend_resume_hook;
  47
  48 /* This structure holds the default values of the console-local
  49    variables defined with DEFVAR_CONSOLE_LOCAL, that have special
  50    slots in each console.  The default value occupies the same slot
  51    in this structure as an individual console's value occupies in
  52    that console.  Setting the default value also goes through the
  53    list of consoles and stores into each console that does not say
  54    it has a local value.  */
  55 Lisp_Object Vconsole_defaults;
  56 static void *console_defaults_saved_slots;
  57
  58 /* This structure marks which slots in a console have corresponding
  59    default values in console_defaults.
  60    Each such slot has a nonzero value in this structure.
  61    The value has only one nonzero bit.
  62
  63    When a console has its own local value for a slot,
  64    the bit for that slot (found in the same slot in this structure)
  65    is turned on in the console's local_var_flags slot.
  66
  67    If a slot in this structure is 0, then there is a DEFVAR_CONSOLE_LOCAL
  68    for the slot, but there is no default value for it; the corresponding
  69    slot in console_defaults is not used except to initialize newly-created
  70    consoles.
  71
  72    If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it
  73   as well as a default value which is used to initialize newly-created
  74    consoles and as a reset-value when local-vars are killed.
  75
  76    If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it.
  77    (The slot is always local, but there's no lisp variable for it.)
  78    The default value is only used to initialize newly-creation consoles.
  79
  80    If a slot is -3, then there is no DEFVAR_CONSOLE_LOCAL for it but
  81    there is a default which is used to initialize newly-creation
  82    consoles and as a reset-value when local-vars are killed.
  83
  84    */
  85 struct console console_local_flags;
  86
  87 /* 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 static Lisp_Object Vconsole_local_symbols;
  90 static void *console_local_symbols_saved_slots;
  91
  92 DEFINE_CONSOLE_TYPE(dead);
  93
  94 Lisp_Object Vconsole_type_list;
  95
  96 console_type_entry_dynarr *the_console_type_entry_dynarr;
  97 \f
  98 static Lisp_Object mark_console(Lisp_Object obj)
  99 {
 100         struct console *con = XCONSOLE(obj);
 101
 102 #define MARKED_SLOT(x) mark_object (con->x)
 103 #include "conslots.h"
 104 #undef MARKED_SLOT
 105
 106         /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */
 107         if (con->conmeths) {
 108                 mark_object(con->conmeths->symbol);
 109                 MAYBE_CONMETH(con, mark_console, (con));
 110         }
 111
 112         return Qnil;
 113 }
 114
 115 static void
 116 print_console(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 117 {
 118         struct console *con = XCONSOLE(obj);
 119
 120         if (print_readably)
 121                 error("printing unreadable object #<console %s 0x%x>",
 122                       XSTRING_DATA(con->name), con->header.uid);
 123
 124         write_fmt_string(printcharfun, "#<%s-console",
 125                          (!CONSOLE_LIVE_P(con) ? "dead" : CONSOLE_TYPE_NAME(con)));
 126         if (CONSOLE_LIVE_P(con) && !NILP(CONSOLE_CONNECTION(con))) {
 127                 write_c_string(" on ", printcharfun);
 128                 print_internal(CONSOLE_CONNECTION(con), printcharfun, 1);
 129         }
 130         write_fmt_str(printcharfun, " 0x%x>", con->header.uid);
 131 }
 132
 133 DEFINE_LRECORD_IMPLEMENTATION("console", console,
 134                               mark_console, print_console, 0, 0, 0, 0,
 135                               struct console);
 136 \f
 137 static struct console *allocate_console(void)
 138 {
 139         Lisp_Object console;
 140         struct console *con =
 141             alloc_lcrecord_type(struct console, &lrecord_console);
 142         struct gcpro gcpro1;
 143
 144         copy_lcrecord(con, XCONSOLE(Vconsole_defaults));
 145
 146         XSETCONSOLE(console, con);
 147         GCPRO1(console);
 148
 149         con->quit_char = 7;     /* C-g */
 150         con->command_builder = allocate_command_builder(console);
 151         con->function_key_map = Fmake_sparse_keymap(Qnil);
 152
 153         UNGCPRO;
 154         return con;
 155 }
 156
 157 struct console *decode_console(Lisp_Object console)
 158 {
 159         if (NILP(console))
 160                 console = Fselected_console();
 161         /* quietly accept devices and frames for the console arg */
 162         if (DEVICEP(console) || FRAMEP(console))
 163                 console = DEVICE_CONSOLE(decode_device(console));
 164         CHECK_LIVE_CONSOLE(console);
 165         return XCONSOLE(console);
 166 }
 167
 168 struct console_methods *decode_console_type(Lisp_Object type,
 169                                             Error_behavior errb)
 170 {
 171         int i;
 172
 173         for (i = 0; i < Dynarr_length(the_console_type_entry_dynarr); i++)
 174                 if (EQ
 175                     (type, Dynarr_at(the_console_type_entry_dynarr, i).symbol))
 176                         return Dynarr_at(the_console_type_entry_dynarr,
 177                                          i).meths;
 178
 179         maybe_signal_simple_error("Invalid console type", type, Qconsole, errb);
 180
 181         return 0;
 182 }
 183
 184 int valid_console_type_p(Lisp_Object type)
 185 {
 186         return decode_console_type(type, ERROR_ME_NOT) != 0;
 187 }
 188
 189 DEFUN("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0,   /*
 190 Return t if CONSOLE-TYPE is a valid console type.
 191 Valid types are 'x, 'tty, and 'stream.
 192 */
 193       (console_type))
 194 {
 195         return valid_console_type_p(console_type) ? Qt : Qnil;
 196 }
 197
 198 DEFUN("console-type-list", Fconsole_type_list, 0, 0, 0, /*
 199 Return a list of valid console types.
 200 */
 201       ())
 202 {
 203         return Fcopy_sequence(Vconsole_type_list);
 204 }
 205
 206 DEFUN("cdfw-console", Fcdfw_console, 1, 1, 0,   /*
 207 Given a console, device, frame, or window, return the associated console.
 208 Return nil otherwise.
 209 */
 210       (object))
 211 {
 212         return CDFW_CONSOLE(object);
 213 }
 214 \f
 215 DEFUN("selected-console", Fselected_console, 0, 0, 0,   /*
 216 Return the console which is currently active.
 217 */
 218       ())
 219 {
 220         return Vselected_console;
 221 }
 222
 223 /* Called from selected_device_1(), called from selected_frame_1(),
 224    called from Fselect_window() */
 225 void select_console_1(Lisp_Object console)
 226 {
 227         /* perhaps this should do something more complicated */
 228         Vselected_console = console;
 229
 230         /* #### Schedule this to be removed in 19.14 */
 231 #ifdef HAVE_X_WINDOWS
 232         if (CONSOLE_X_P(XCONSOLE(console)))
 233                 Vwindow_system = Qx;
 234         else
 235 #endif
 236 #ifdef HAVE_GTK
 237         if (CONSOLE_GTK_P(XCONSOLE(console)))
 238                 Vwindow_system = Qgtk;
 239         else
 240 #endif
 241                 Vwindow_system = Qnil;
 242 }
 243
 244 DEFUN("select-console", Fselect_console, 1, 1, 0,       /*
 245 Select the console CONSOLE.
 246 Subsequent editing commands apply to its selected device, selected frame,
 247 and selected window.  The selection of CONSOLE lasts until the next time
 248 the user does something to select a different console, or until the next
 249 time this function is called.
 250 */
 251       (console))
 252 {
 253         Lisp_Object device;
 254
 255         CHECK_LIVE_CONSOLE(console);
 256
 257         device = CONSOLE_SELECTED_DEVICE(XCONSOLE(console));
 258         if (!NILP(device)) {
 259                 struct device *d = XDEVICE(device);
 260                 Lisp_Object frame = DEVICE_SELECTED_FRAME(d);
 261                 if (!NILP(frame)) {
 262                         struct frame *f = XFRAME(frame);
 263                         Fselect_window(FRAME_SELECTED_WINDOW(f), Qnil);
 264                 } else
 265                         error("Can't select console with no frames.");
 266         } else
 267                 error("Can't select a console with no devices");
 268         return Qnil;
 269 }
 270
 271 void set_console_last_nonminibuf_frame(struct console *con, Lisp_Object frame)
 272 {
 273         con->last_nonminibuf_frame = frame;
 274 }
 275
 276 DEFUN("consolep", Fconsolep, 1, 1, 0,   /*
 277 Return non-nil if OBJECT is a console.
 278 */
 279       (object))
 280 {
 281         return CONSOLEP(object) ? Qt : Qnil;
 282 }
 283
 284 DEFUN("console-live-p", Fconsole_live_p, 1, 1, 0,       /*
 285 Return non-nil if OBJECT is a console that has not been deleted.
 286 */
 287       (object))
 288 {
 289         return CONSOLEP(object) && CONSOLE_LIVE_P(XCONSOLE(object)) ? Qt : Qnil;
 290 }
 291
 292 DEFUN("console-type", Fconsole_type, 0, 1, 0,   /*
 293 Return the console type (e.g. `x' or `tty') of CONSOLE.
 294 Value is `tty' for a tty console (a character-only terminal),
 295 `x' for a console that is an X display,
 296 `mswindows' for a console that is a Windows NT/95/97 connection,
 297 `pc' for a console that is a direct-write MS-DOS connection (not yet
 298 implemented),
 299 `stream' for a stream console (which acts like a stdio stream), and
 300 `dead' for a deleted console.
 301 */
 302       (console))
 303 {
 304         /* don't call decode_console() because we want to allow for dead
 305            consoles. */
 306         if (NILP(console))
 307                 console = Fselected_console();
 308         CHECK_CONSOLE(console);
 309         return CONSOLE_TYPE(XCONSOLE(console));
 310 }
 311
 312 DEFUN("console-name", Fconsole_name, 0, 1, 0,   /*
 313 Return the name of CONSOLE.
 314 */
 315       (console))
 316 {
 317         return CONSOLE_NAME(decode_console(console));
 318 }
 319
 320 DEFUN("console-connection", Fconsole_connection, 0, 1, 0,       /*
 321 Return the connection of the specified console.
 322 CONSOLE defaults to the selected console if omitted.
 323 */
 324       (console))
 325 {
 326         return CONSOLE_CONNECTION(decode_console(console));
 327 }
 328
 329 Lisp_Object make_console(struct console * con)
 330 {
 331         Lisp_Object console;
 332         XSETCONSOLE(console, con);
 333         return console;
 334 }
 335
 336 static Lisp_Object
 337 semi_canonicalize_console_connection(struct console_methods *meths,
 338                                      Lisp_Object name, Error_behavior errb)
 339 {
 340         if (HAS_CONTYPE_METH_P(meths, semi_canonicalize_console_connection))
 341                 return CONTYPE_METH(meths, semi_canonicalize_console_connection,
 342                                     (name, errb));
 343         else
 344                 return CONTYPE_METH_OR_GIVEN(meths,
 345                                              canonicalize_console_connection,
 346                                              (name, errb), name);
 347 }
 348
 349 static Lisp_Object
 350 canonicalize_console_connection(struct console_methods *meths,
 351                                 Lisp_Object name, Error_behavior errb)
 352 {
 353         if (HAS_CONTYPE_METH_P(meths, canonicalize_console_connection))
 354                 return CONTYPE_METH(meths, canonicalize_console_connection,
 355                                     (name, errb));
 356         else
 357                 return CONTYPE_METH_OR_GIVEN(meths,
 358                                              semi_canonicalize_console_connection,
 359                                              (name, errb), name);
 360 }
 361
 362 static Lisp_Object
 363 find_console_of_type(struct console_methods *meths, Lisp_Object canon)
 364 {
 365         Lisp_Object concons;
 366
 367         CONSOLE_LOOP(concons) {
 368                 Lisp_Object console = XCAR(concons);
 369
 370                 if (EQ(CONMETH_TYPE(meths), CONSOLE_TYPE(XCONSOLE(console)))
 371                     &&
 372                     internal_equal(CONSOLE_CANON_CONNECTION(XCONSOLE(console)),
 373                                    canon, 0))
 374                         return console;
 375         }
 376
 377         return Qnil;
 378 }
 379
 380 DEFUN("find-console", Ffind_console, 1, 2, 0,   /*
 381 Look for an existing console attached to connection CONNECTION.
 382 Return the console if found; otherwise, return nil.
 383
 384 If TYPE is specified, only return consoles of that type; otherwise,
 385 return consoles of any type. (It is possible, although unlikely,
 386 that two consoles of different types could have the same connection
 387 name; in such a case, the first console found is returned.)
 388 */
 389       (connection, type))
 390 {
 391         Lisp_Object canon = Qnil;
 392         struct gcpro gcpro1;
 393
 394         GCPRO1(canon);
 395
 396         if (!NILP(type)) {
 397                 struct console_methods *conmeths =
 398                     decode_console_type(type, ERROR_ME);
 399                 canon =
 400                     canonicalize_console_connection(conmeths, connection,
 401                                                     ERROR_ME_NOT);
 402                 if (UNBOUNDP(canon))
 403                         RETURN_UNGCPRO(Qnil);
 404
 405                 RETURN_UNGCPRO(find_console_of_type(conmeths, canon));
 406         } else {
 407                 int i;
 408
 409                 for (i = 0; i < Dynarr_length(the_console_type_entry_dynarr);
 410                      i++) {
 411                         struct console_methods *conmeths =
 412                             Dynarr_at(the_console_type_entry_dynarr, i).meths;
 413                         canon =
 414                             canonicalize_console_connection(conmeths,
 415                                                             connection,
 416                                                             ERROR_ME_NOT);
 417                         if (!UNBOUNDP(canon)) {
 418                                 Lisp_Object console =
 419                                     find_console_of_type(conmeths, canon);
 420                                 if (!NILP(console))
 421                                         RETURN_UNGCPRO(console);
 422                         }
 423                 }
 424
 425                 RETURN_UNGCPRO(Qnil);
 426         }
 427 }
 428
 429 DEFUN("get-console", Fget_console, 1, 2, 0,     /*
 430 Look for an existing console attached to connection CONNECTION.
 431 Return the console if found; otherwise, signal an error.
 432
 433 If TYPE is specified, only return consoles of that type; otherwise,
 434 return consoles of any type. (It is possible, although unlikely,
 435 that two consoles of different types could have the same connection
 436 name; in such a case, the first console found is returned.)
 437 */
 438       (connection, type))
 439 {
 440         Lisp_Object console = Ffind_console(connection, type);
 441         if (NILP(console)) {
 442                 if (NILP(type))
 443                         signal_simple_error("No such console", connection);
 444                 else
 445                         signal_simple_error_2("No such console", type,
 446                                               connection);
 447         }
 448         return console;
 449 }
 450
 451 Lisp_Object
 452 create_console(Lisp_Object name, Lisp_Object type, Lisp_Object connection,
 453                Lisp_Object props)
 454 {
 455         /* This function can GC */
 456         struct console *con;
 457         Lisp_Object console;
 458         struct gcpro gcpro1;
 459
 460         console = Ffind_console(connection, type);
 461         if (!NILP(console))
 462                 return console;
 463
 464         con = allocate_console();
 465         XSETCONSOLE(console, con);
 466
 467         GCPRO1(console);
 468
 469         con->conmeths = decode_console_type(type, ERROR_ME);
 470
 471         CONSOLE_NAME(con) = name;
 472         CONSOLE_CONNECTION(con) =
 473             semi_canonicalize_console_connection(con->conmeths, connection,
 474                                                  ERROR_ME);
 475         CONSOLE_CANON_CONNECTION(con) =
 476             canonicalize_console_connection(con->conmeths, connection,
 477                                             ERROR_ME);
 478
 479         MAYBE_CONMETH(con, init_console, (con, props));
 480
 481         /* Do it this way so that the console list is in order of creation */
 482         Vconsole_list = nconc2(Vconsole_list, Fcons(console, Qnil));
 483
 484         if (CONMETH_OR_GIVEN(con, initially_selected_for_input, (con), 0))
 485                 event_stream_select_console(con);
 486
 487         UNGCPRO;
 488         return console;
 489 }
 490
 491 void
 492 add_entry_to_console_type_list(Lisp_Object symbol,
 493                                struct console_methods *meths)
 494 {
 495         struct console_type_entry entry;
 496
 497         entry.symbol = symbol;
 498         entry.meths = meths;
 499         Dynarr_add(the_console_type_entry_dynarr, entry);
 500         Vconsole_type_list = Fcons(symbol, Vconsole_type_list);
 501 }
 502
 503 /* find a console other than the selected one.  Prefer non-stream
 504    consoles over stream consoles. */
 505
 506 static Lisp_Object find_other_console(Lisp_Object console)
 507 {
 508         Lisp_Object concons;
 509
 510         /* look for a non-stream console */
 511         CONSOLE_LOOP(concons) {
 512                 Lisp_Object con = XCAR(concons);
 513                 if (!CONSOLE_STREAM_P(XCONSOLE(con))
 514                     && !EQ(con, console)
 515                     && !NILP(CONSOLE_SELECTED_DEVICE(XCONSOLE(con)))
 516                     && !NILP(DEVICE_SELECTED_FRAME
 517                              (XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(con))))))
 518                         break;
 519         }
 520         if (!NILP(concons))
 521                 return XCAR(concons);
 522
 523         /* OK, now look for a stream console */
 524         CONSOLE_LOOP(concons) {
 525                 Lisp_Object con = XCAR(concons);
 526                 if (!EQ(con, console)
 527                     && !NILP(CONSOLE_SELECTED_DEVICE(XCONSOLE(con)))
 528                     && !NILP(DEVICE_SELECTED_FRAME
 529                              (XDEVICE(CONSOLE_SELECTED_DEVICE(XCONSOLE(con))))))
 530                         break;
 531         }
 532         if (!NILP(concons))
 533                 return XCAR(concons);
 534
 535         /* Sorry, there ain't none */
 536         return Qnil;
 537 }
 538
 539 static int
 540 find_nonminibuffer_frame_not_on_console_predicate(Lisp_Object frame,
 541                                                   void *closure)
 542 {
 543         Lisp_Object console;
 544
 545         VOID_TO_LISP(console, closure);
 546         if (FRAME_MINIBUF_ONLY_P(XFRAME(frame)))
 547                 return 0;
 548         if (EQ(console, FRAME_CONSOLE(XFRAME(frame))))
 549                 return 0;
 550         return 1;
 551 }
 552
 553 static Lisp_Object find_nonminibuffer_frame_not_on_console(Lisp_Object console)
 554 {
 555         return
 556             find_some_frame(find_nonminibuffer_frame_not_on_console_predicate,
 557                             LISP_TO_VOID(console));
 558 }
 559
 560 /* Delete console CON.
 561
 562    If FORCE is non-zero, allow deletion of the only frame.
 563
 564    If CALLED_FROM_KILL_EMACS is non-zero, then, if
 565    deleting the last console, just delete it,
 566    instead of calling `save-buffers-kill-emacs'.
 567
 568    If FROM_IO_ERROR is non-zero, then the console is gone due
 569    to an I/O error.  This affects what happens if we exit
 570    (we do an emergency exit instead of `save-buffers-kill-emacs'.)
 571 */
 572
 573 void
 574 delete_console_internal(struct console *con, int force,
 575                         int called_from_kill_emacs, int from_io_error)
 576 {
 577         /* This function can GC */
 578         Lisp_Object console;
 579         struct gcpro gcpro1;
 580
 581         /* OK to delete an already-deleted console. */
 582         if (!CONSOLE_LIVE_P(con))
 583                 return;
 584
 585         XSETCONSOLE(console, con);
 586         GCPRO1(console);
 587
 588         if (!called_from_kill_emacs) {
 589                 int down_we_go = 0;
 590
 591                 if ((XINT(Flength(Vconsole_list)) == 1)
 592                     /* if we just created the console, it might not be listed,
 593                        or something ... */
 594                     && !NILP(memq_no_quit(console, Vconsole_list)))
 595                         down_we_go = 1;
 596                 /* If there aren't any nonminibuffer frames that would
 597                    be left, then exit. */
 598                 else if (NILP(find_nonminibuffer_frame_not_on_console(console)))
 599                         down_we_go = 1;
 600
 601                 if (down_we_go) {
 602                         if (!force)
 603                                 error("Attempt to delete the only frame");
 604                         else if (from_io_error) {
 605                                 /* Mayday mayday!  We're going down! */
 606                                 stderr_out("  Autosaving and exiting...\n");
 607                                 Vwindow_system = Qnil;  /* let it lie! */
 608                                 preparing_for_armageddon = 1;
 609                                 Fkill_emacs(make_int(70));
 610                         } else {
 611                                 call0(Qsave_buffers_kill_emacs);
 612                                 UNGCPRO;
 613                                 /* If we get here, the user said they didn't want
 614                                    to exit, so don't. */
 615                                 return;
 616                         }
 617                 }
 618         }
 619
 620         /* Breathe a sigh of relief.  We're still alive. */
 621
 622         {
 623                 Lisp_Object frmcons, devcons;
 624
 625                 /* First delete all frames without their own minibuffers,
 626                    to avoid errors coming from attempting to delete a frame
 627                    that is a surrogate for another frame.
 628
 629                    We don't set "called_from_delete_console" because we want the
 630                    device to go ahead and get deleted if we delete the last frame
 631                    on a device.  We won't run into trouble here because for any
 632                    frame without a minibuffer, there has to be another one on
 633                    the same console with a minibuffer, and we're not deleting that,
 634                    so delete_console_internal() won't get recursively called.
 635
 636                    WRONG!  With surrogate minibuffers this isn't true.  Frames
 637                    with only a minibuffer are not enough to prevent
 638                    delete_frame_internal from triggering a device deletion. */
 639                 CONSOLE_FRAME_LOOP_NO_BREAK(frmcons, devcons, con) {
 640                         struct frame *f = XFRAME(XCAR(frmcons));
 641                         /* delete_frame_internal() might do anything such as run hooks,
 642                            so be defensive. */
 643                         if (FRAME_LIVE_P(f) && !FRAME_HAS_MINIBUF_P(f))
 644                                 delete_frame_internal(f, 1, 1, from_io_error);
 645
 646                         if (!CONSOLE_LIVE_P(con)) {     /* make sure the delete-*-hook didn't
 647                                                            go ahead and delete anything */
 648                                 UNGCPRO;
 649                                 return;
 650                         }
 651                 }
 652
 653                 CONSOLE_DEVICE_LOOP(devcons, con) {
 654                         struct device *d = XDEVICE(XCAR(devcons));
 655                         /* delete_device_internal() might do anything such as run hooks,
 656                            so be defensive. */
 657                         if (DEVICE_LIVE_P(d))
 658                                 delete_device_internal(d, 1, 1, from_io_error);
 659                         if (!CONSOLE_LIVE_P(con)) {     /* make sure the delete-*-hook didn't
 660                                                            go ahead and delete anything */
 661                                 UNGCPRO;
 662                                 return;
 663                         }
 664                 }
 665         }
 666
 667         CONSOLE_SELECTED_DEVICE(con) = Qnil;
 668
 669         /* try to select another console */
 670
 671         if (EQ(console, Fselected_console())) {
 672                 Lisp_Object other_dev = find_other_console(console);
 673                 if (!NILP(other_dev))
 674                         Fselect_console(other_dev);
 675                 else {
 676                         /* necessary? */
 677                         Vselected_console = Qnil;
 678                         Vwindow_system = Qnil;
 679                 }
 680         }
 681
 682         if (con->input_enabled)
 683                 event_stream_unselect_console(con);
 684
 685         MAYBE_CONMETH(con, delete_console, (con));
 686
 687         Vconsole_list = delq_no_quit(console, Vconsole_list);
 688         RESET_CHANGED_SET_FLAGS;
 689         con->conmeths = dead_console_methods;
 690
 691         UNGCPRO;
 692 }
 693
 694 void io_error_delete_console(Lisp_Object console)
 695 {
 696         delete_console_internal(XCONSOLE(console), 1, 0, 1);
 697 }
 698
 699 DEFUN("delete-console", Fdelete_console, 1, 2, 0,       /*
 700 Delete CONSOLE, permanently eliminating it from use.
 701 Normally, you cannot delete the last non-minibuffer-only frame (you must
 702 use `save-buffers-kill-emacs' or `kill-emacs').  However, if optional
 703 second argument FORCE is non-nil, you can delete the last frame. (This
 704 will automatically call `save-buffers-kill-emacs'.)
 705 */
 706       (console, force))
 707 {
 708         CHECK_CONSOLE(console);
 709         delete_console_internal(XCONSOLE(console), !NILP(force), 0, 0);
 710         return Qnil;
 711 }
 712
 713 DEFUN("console-list", Fconsole_list, 0, 0, 0,   /*
 714 Return a list of all consoles.
 715 */
 716       ())
 717 {
 718         return Fcopy_sequence(Vconsole_list);
 719 }
 720
 721 DEFUN("console-device-list", Fconsole_device_list, 0, 1, 0,     /*
 722 Return a list of all devices on CONSOLE.
 723 If CONSOLE is nil, the selected console is used.
 724 */
 725       (console))
 726 {
 727         return Fcopy_sequence(CONSOLE_DEVICE_LIST(decode_console(console)));
 728 }
 729
 730 DEFUN("console-enable-input", Fconsole_enable_input, 1, 1, 0,   /*
 731 Enable input on console CONSOLE.
 732 */
 733       (console))
 734 {
 735         struct console *con = decode_console(console);
 736         if (!con->input_enabled)
 737                 event_stream_select_console(con);
 738         return Qnil;
 739 }
 740
 741 DEFUN("console-disable-input", Fconsole_disable_input, 1, 1, 0, /*
 742 Disable input on console CONSOLE.
 743 */
 744       (console))
 745 {
 746         struct console *con = decode_console(console);
 747         if (con->input_enabled)
 748                 event_stream_unselect_console(con);
 749         return Qnil;
 750 }
 751
 752 DEFUN("console-on-window-system-p", Fconsole_on_window_system_p, 0, 1, 0,       /*
 753 Return t if CONSOLE is on a window system.
 754 If CONSOLE is nil, the selected console is used.
 755 This generally means that there is support for the mouse, the menubar,
 756 the toolbar, glyphs, etc.
 757 */
 758       (console))
 759 {
 760         Lisp_Object type = CONSOLE_TYPE(decode_console(console));
 761
 762         return !EQ(type, Qtty) && !EQ(type, Qstream) ? Qt : Qnil;
 763 }
 764 \f
 765 /**********************************************************************/
 766 /*               Miscellaneous low-level functions                    */
 767 /**********************************************************************/
 768
 769 static Lisp_Object unwind_init_sys_modes(Lisp_Object console)
 770 {
 771         reinit_initial_console();
 772
 773         if (!no_redraw_on_reenter &&
 774             CONSOLEP(console) && CONSOLE_LIVE_P(XCONSOLE(console))) {
 775                 struct frame *f =
 776                     XFRAME(DEVICE_SELECTED_FRAME
 777                            (XDEVICE
 778                             (CONSOLE_SELECTED_DEVICE(XCONSOLE(console)))));
 779                 MARK_FRAME_CHANGED(f);
 780         }
 781         return Qnil;
 782 }
 783
 784 DEFUN("suspend-emacs", Fsuspend_emacs, 0, 1, "",        /*
 785 Stop Emacs and return to superior process.  You can resume later.
 786 On systems that don't have job control, run a subshell instead.
 787
 788 If optional arg STUFFSTRING is non-nil, its characters are stuffed
 789 to be read as terminal input by Emacs's superior shell.
 790
 791 Before suspending, run the normal hook `suspend-hook'.
 792 After resumption run the normal hook `suspend-resume-hook'.
 793
 794 Some operating systems cannot stop the Emacs process and resume it later.
 795 On such systems, Emacs will start a subshell and wait for it to exit.
 796 */
 797       (stuffstring))
 798 {
 799         int speccount = specpdl_depth();
 800         struct gcpro gcpro1;
 801
 802         if (!NILP(stuffstring))
 803                 CHECK_STRING(stuffstring);
 804         GCPRO1(stuffstring);
 805
 806         /* There used to be a check that the initial console is TTY.
 807            This is bogus.  Even checking to see whether any console
 808            is a controlling terminal is not correct -- maybe
 809            the user used the -t option or something.  If we want to
 810            suspend, then we suspend.  Period. */
 811
 812         /* Call value of suspend-hook. */
 813         run_hook(Qsuspend_hook);
 814
 815         reset_initial_console();
 816         /* sys_suspend can get an error if it tries to fork a subshell
 817            and the system resources aren't available for that.  */
 818         record_unwind_protect(unwind_init_sys_modes, Vcontrolling_terminal);
 819         stuff_buffered_input(stuffstring);
 820         sys_suspend();
 821         /* the console is un-reset inside of the unwind-protect. */
 822         unbind_to(speccount, Qnil);
 823
 824 #ifdef SIGWINCH
 825         /* It is possible that a size change occurred while we were
 826            suspended.  Assume one did just to be safe.  It won't hurt
 827            anything if one didn't. */
 828         asynch_device_change_pending++;
 829 #endif
 830
 831         /* Call value of suspend-resume-hook
 832            if it is bound and value is non-nil.  */
 833         run_hook(Qsuspend_resume_hook);
 834
 835         UNGCPRO;
 836         return Qnil;
 837 }
 838
 839 /* If STUFFSTRING is a string, stuff its contents as pending terminal input.
 840    Then in any case stuff anything Emacs has read ahead and not used.  */
 841
 842 void stuff_buffered_input(Lisp_Object stuffstring)
 843 {
 844 /* stuff_char works only in BSD, versions 4.2 and up.  */
 845 #if defined (BSD) && defined (HAVE_TTY)
 846         if (!CONSOLEP(Vcontrolling_terminal) ||
 847             !CONSOLE_LIVE_P(XCONSOLE(Vcontrolling_terminal)))
 848                 return;
 849
 850         if (STRINGP(stuffstring)) {
 851                 Extcount count;
 852                 Extbyte *p;
 853
 854                 TO_EXTERNAL_FORMAT(LISP_STRING, stuffstring,
 855                                    ALLOCA, (p, count), Qkeyboard);
 856                 while (count-- > 0)
 857                         stuff_char(XCONSOLE(Vcontrolling_terminal), *p++);
 858                 stuff_char(XCONSOLE(Vcontrolling_terminal), '\n');
 859         }
 860         /* Anything we have read ahead, put back for the shell to read.  */
 861 # if 0                          /* oh, who cares about this silliness */
 862         while (kbd_fetch_ptr != kbd_store_ptr) {
 863                 if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE)
 864                         kbd_fetch_ptr = kbd_buffer;
 865                 stuff_char(XCONSOLE(Vcontrolling_terminal), *kbd_fetch_ptr++);
 866         }
 867 # endif
 868 #endif                          /* BSD && HAVE_TTY */
 869 }
 870
 871 DEFUN("suspend-console", Fsuspend_console, 0, 1, "",    /*
 872 Suspend a console.  For tty consoles, it sends a signal to suspend
 873 the process in charge of the tty, and removes the devices and
 874 frames of that console from the display.
 875
 876 If optional arg CONSOLE is non-nil, it is the console to be suspended.
 877 Otherwise it is assumed to be the selected console.
 878
 879 Some operating systems cannot stop processes and resume them later.
 880 On such systems, who knows what will happen.
 881 */
 882       (console))
 883 {
 884 #ifdef HAVE_TTY
 885         struct console *con = decode_console(console);
 886
 887         if (CONSOLE_TTY_P(con)) {
 888                 /*
 889                  * hide all the unhidden frames so the display code won't update
 890                  * them while the console is suspended.
 891                  */
 892                 Lisp_Object device = CONSOLE_SELECTED_DEVICE(con);
 893                 if (!NILP(device)) {
 894                         struct device *d = XDEVICE(device);
 895                         Lisp_Object frame_list = DEVICE_FRAME_LIST(d);
 896                         while (CONSP(frame_list)) {
 897                                 struct frame *f = XFRAME(XCAR(frame_list));
 898                                 if (FRAME_REPAINT_P(f))
 899                                         f->visible = -1;
 900                                 frame_list = XCDR(frame_list);
 901                         }
 902                 }
 903                 reset_one_console(con);
 904                 event_stream_unselect_console(con);
 905                 sys_suspend_process(XINT
 906                                     (Fconsole_tty_controlling_process
 907                                      (console)));
 908         }
 909 #endif                          /* HAVE_TTY */
 910
 911         return Qnil;
 912 }
 913
 914 DEFUN("resume-console", Fresume_console, 1, 1, "",      /*
 915 Re-initialize a previously suspended console.
 916 For tty consoles, do stuff to the tty to make it sane again.
 917 */
 918       (console))
 919 {
 920 #ifdef HAVE_TTY
 921         struct console *con = decode_console(console);
 922
 923         if (CONSOLE_TTY_P(con)) {
 924                 /* raise the selected frame */
 925                 Lisp_Object device = CONSOLE_SELECTED_DEVICE(con);
 926                 if (!NILP(device)) {
 927                         struct device *d = XDEVICE(device);
 928                         Lisp_Object frame = DEVICE_SELECTED_FRAME(d);
 929                         if (!NILP(frame)) {
 930                                 /* force the frame to be cleared */
 931                                 SET_FRAME_CLEAR(XFRAME(frame));
 932                                 Fraise_frame(frame);
 933                         }
 934                 }
 935                 init_one_console(con);
 936                 event_stream_select_console(con);
 937 #ifdef SIGWINCH
 938                 /* The same as in Fsuspend_emacs: it is possible that a size
 939                    change occurred while we were suspended.  Assume one did just
 940                    to be safe.  It won't hurt anything if one didn't. */
 941                 asynch_device_change_pending++;
 942 #endif
 943         }
 944 #endif                          /* HAVE_TTY */
 945
 946         return Qnil;
 947 }
 948
 949 DEFUN("set-input-mode", Fset_input_mode, 3, 5, 0,       /*
 950 Set mode of reading keyboard input.
 951 First arg is ignored, for backward compatibility.
 952 Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal
 953 (no effect except in CBREAK mode).
 954 Third arg META t means accept 8-bit input (for a Meta key).
 955 META nil means ignore the top bit, on the assumption it is parity.
 956 Otherwise, accept 8-bit input and don't use the top bit for Meta.
 957 First three arguments only apply to TTY consoles.
 958 Optional fourth arg QUIT if non-nil specifies character to use for quitting.
 959 Optional fifth arg CONSOLE specifies console to make changes to; nil means
 960 the selected console.
 961 See also `current-input-mode'.
 962 */
 963       (ignored, flow, meta, quit, console))
 964 {
 965         struct console *con = decode_console(console);
 966         int meta_key = (!CONSOLE_TTY_P(con) ? 1 :
 967                         EQ(meta, Qnil) ? 0 : EQ(meta, Qt) ? 1 : 2);
 968
 969         if (!NILP(quit)) {
 970                 CHECK_CHAR_COERCE_INT(quit);
 971                 CONSOLE_QUIT_CHAR(con) =
 972                     ((unsigned int)XCHAR(quit)) & (meta_key ? 0377 : 0177);
 973         }
 974 #ifdef HAVE_TTY
 975         if (CONSOLE_TTY_P(con)) {
 976                 reset_one_console(con);
 977                 TTY_FLAGS(con).flow_control = !NILP(flow);
 978                 TTY_FLAGS(con).meta_key = meta_key;
 979                 init_one_console(con);
 980                 MARK_FRAME_CHANGED(XFRAME(CONSOLE_SELECTED_FRAME(con)));
 981         }
 982 #endif
 983
 984         return Qnil;
 985 }
 986
 987 DEFUN("current-input-mode", Fcurrent_input_mode, 0, 1, 0,       /*
 988 Return information about the way Emacs currently reads keyboard input.
 989 Optional arg CONSOLE specifies console to return information about; nil means
 990 the selected console.
 991 The value is a list of the form (nil FLOW META QUIT), where
 992 FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the
 993 terminal; this does not apply if Emacs uses interrupt-driven input.
 994 META is t if accepting 8-bit input with 8th bit as Meta flag.
 995 META nil means ignoring the top bit, on the assumption it is parity.
 996 META is neither t nor nil if accepting 8-bit input and using
 997 all 8 bits as the character code.
 998 QUIT is the character Emacs currently uses to quit.
 999 FLOW, and META are only meaningful for TTY consoles.
1000 The elements of this list correspond to the arguments of
1001 `set-input-mode'.
1002 */
1003       (console))
1004 {
1005         struct console *con = decode_console(console);
1006         Lisp_Object flow, meta, quit;
1007
1008 #ifdef HAVE_TTY
1009         flow = CONSOLE_TTY_P(con) && TTY_FLAGS(con).flow_control ? Qt : Qnil;
1010         meta = (!CONSOLE_TTY_P(con) ? Qt :
1011                 TTY_FLAGS(con).meta_key == 1 ? Qt :
1012                 TTY_FLAGS(con).meta_key == 2 ? Qzero : Qnil);
1013 #else
1014         flow = Qnil;
1015         meta = Qt;
1016 #endif
1017         quit = make_char(CONSOLE_QUIT_CHAR(con));
1018
1019         return list4(Qnil, flow, meta, quit);
1020 }
1021 \f
1022 /************************************************************************/
1023 /*                            initialization                            */
1024 /************************************************************************/
1025
1026 void syms_of_console(void)
1027 {
1028         INIT_LRECORD_IMPLEMENTATION(console);
1029
1030         DEFSUBR(Fvalid_console_type_p);
1031         DEFSUBR(Fconsole_type_list);
1032         DEFSUBR(Fcdfw_console);
1033         DEFSUBR(Fselected_console);
1034         DEFSUBR(Fselect_console);
1035         DEFSUBR(Fconsolep);
1036         DEFSUBR(Fconsole_live_p);
1037         DEFSUBR(Fconsole_type);
1038         DEFSUBR(Fconsole_name);
1039         DEFSUBR(Fconsole_connection);
1040         DEFSUBR(Ffind_console);
1041         DEFSUBR(Fget_console);
1042         DEFSUBR(Fdelete_console);
1043         DEFSUBR(Fconsole_list);
1044         DEFSUBR(Fconsole_device_list);
1045         DEFSUBR(Fconsole_enable_input);
1046         DEFSUBR(Fconsole_disable_input);
1047         DEFSUBR(Fconsole_on_window_system_p);
1048         DEFSUBR(Fsuspend_console);
1049         DEFSUBR(Fresume_console);
1050
1051         DEFSUBR(Fsuspend_emacs);
1052         DEFSUBR(Fset_input_mode);
1053         DEFSUBR(Fcurrent_input_mode);
1054
1055         defsymbol(&Qconsolep, "consolep");
1056         defsymbol(&Qconsole_live_p, "console-live-p");
1057
1058         defsymbol(&Qcreate_console_hook, "create-console-hook");
1059         defsymbol(&Qdelete_console_hook, "delete-console-hook");
1060
1061         defsymbol(&Qsuspend_hook, "suspend-hook");
1062         defsymbol(&Qsuspend_resume_hook, "suspend-resume-hook");
1063 }
1064
1065 static const struct lrecord_description cte_description_1[] = {
1066         {XD_LISP_OBJECT, offsetof(console_type_entry, symbol)},
1067         {XD_STRUCT_PTR, offsetof(console_type_entry, meths), 1,
1068          &console_methods_description},
1069         {XD_END}
1070 };
1071
1072 static const struct struct_description cte_description = {
1073         sizeof(console_type_entry),
1074         cte_description_1
1075 };
1076
1077 static const struct lrecord_description cted_description_1[] = {
1078         XD_DYNARR_DESC(console_type_entry_dynarr, &cte_description),
1079         {XD_END}
1080 };
1081
1082 const struct struct_description cted_description = {
1083         sizeof(console_type_entry_dynarr),
1084         cted_description_1
1085 };
1086
1087 static const struct lrecord_description console_methods_description_1[] = {
1088         {XD_LISP_OBJECT, offsetof(struct console_methods, symbol)},
1089         {XD_LISP_OBJECT, offsetof(struct console_methods, predicate_symbol)},
1090         {XD_LISP_OBJECT,
1091          offsetof(struct console_methods, image_conversion_list)},
1092         {XD_END}
1093 };
1094
1095 const struct struct_description console_methods_description = {
1096         sizeof(struct console_methods),
1097         console_methods_description_1
1098 };
1099
1100 void console_type_create(void)
1101 {
1102         the_console_type_entry_dynarr = Dynarr_new(console_type_entry);
1103         dump_add_root_struct_ptr(&the_console_type_entry_dynarr,
1104                                  &cted_description);
1105
1106         Vconsole_type_list = Qnil;
1107         staticpro(&Vconsole_type_list);
1108
1109         /* Initialize the dead console type */
1110         INITIALIZE_CONSOLE_TYPE(dead, "dead", "console-dead-p");
1111
1112         /* then reset the console-type lists, because `dead' is not really
1113            a valid console type */
1114         Dynarr_reset(the_console_type_entry_dynarr);
1115         Vconsole_type_list = Qnil;
1116 }
1117
1118 void reinit_vars_of_console(void)
1119 {
1120         staticpro_nodump(&Vconsole_list);
1121         Vconsole_list = Qnil;
1122         staticpro_nodump(&Vselected_console);
1123         Vselected_console = Qnil;
1124 }
1125
1126 void vars_of_console(void)
1127 {
1128         reinit_vars_of_console();
1129
1130         DEFVAR_LISP("create-console-hook", &Vcreate_console_hook        /*
1131 Function or functions to call when a console is created.
1132 One argument, the newly-created console.
1133 This is called after the first frame has been created, but before
1134 calling the `create-device-hook' or `create-frame-hook'.
1135 Note that in general the console will not be selected.
1136                                                                          */ );
1137         Vcreate_console_hook = Qnil;
1138
1139         DEFVAR_LISP("delete-console-hook", &Vdelete_console_hook        /*
1140 Function or functions to call when a console is deleted.
1141 One argument, the to-be-deleted console.
1142                                                                          */ );
1143         Vdelete_console_hook = Qnil;
1144
1145 #ifdef HAVE_WINDOW_SYSTEM
1146         Fprovide(intern("window-system"));
1147 #endif
1148 }
1149
1150 /* The docstrings for DEFVAR_* are recorded externally by make-docfile.  */
1151 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
1152
1153 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do {  \
1154   static const struct symbol_value_forward I_hate_C =                           \
1155   { /* struct symbol_value_forward */                                           \
1156     { /* struct symbol_value_magic */                                           \
1157       { /* struct lcrecord_header */                                            \
1158         { /* struct lrecord_header */                                           \
1159           lrecord_type_symbol_value_forward, /* lrecord_type_index */           \
1160           1, /* mark bit */                                                     \
1161           1, /* c_readonly bit */                                               \
1162           1  /* lisp_readonly bit */                                            \
1163         },                                                                      \
1164         0, /* uid  */                                                           \
1165         0  /* free */                                                           \
1166       },                                                                        \
1167       &(console_local_flags.field_name),                                        \
1168       forward_type                                                              \
1169     },                                                                          \
1170     magicfun                                                                    \
1171   };                                                                            \
1172                                                                                 \
1173   {                                                                             \
1174     int offset = ((char *)symbol_value_forward_forward (&I_hate_C)              \
1175                   - (char *)&console_local_flags);                              \
1176                                                                                 \
1177     defvar_magic (lname, &I_hate_C);                                            \
1178                                                                                 \
1179     *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols)))      \
1180       = intern (lname);                                                         \
1181   }                                                                             \
1182 } while (0)
1183
1184 #else  /* !BDWGC */
1185
1186 #define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do {  \
1187   static const struct symbol_value_forward I_hate_C =                           \
1188   { /* struct symbol_value_forward */                                           \
1189     { /* struct symbol_value_magic */                                           \
1190       { /* struct lcrecord_header */                                            \
1191         { /* struct lrecord_header */                                           \
1192           lrecord_type_symbol_value_forward, /* lrecord_type_index */           \
1193           1, /* mark bit */                                                     \
1194           1, /* c_readonly bit */                                               \
1195           1  /* lisp_readonly bit */                                            \
1196         },                                                                      \
1197         0, /* next */                                                           \
1198         0, /* uid  */                                                           \
1199         0  /* free */                                                           \
1200       },                                                                        \
1201       &(console_local_flags.field_name),                                        \
1202       forward_type                                                              \
1203     },                                                                          \
1204     magicfun                                                                    \
1205   };                                                                            \
1206                                                                                 \
1207   {                                                                             \
1208     int offset = ((char *)symbol_value_forward_forward (&I_hate_C)              \
1209                   - (char *)&console_local_flags);                              \
1210                                                                                 \
1211     defvar_magic (lname, &I_hate_C);                                            \
1212                                                                                 \
1213     *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols)))      \
1214       = intern (lname);                                                         \
1215   }                                                                             \
1216 } while (0)
1217
1218 #endif  /* BDWGC */
1219
1220 #define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun)         \
1221         DEFVAR_CONSOLE_LOCAL_1 (lname, field_name,                      \
1222                                 SYMVAL_SELECTED_CONSOLE_FORWARD, magicfun)
1223 #define DEFVAR_CONSOLE_LOCAL(lname, field_name)                         \
1224         DEFVAR_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
1225 #define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun)   \
1226         DEFVAR_CONSOLE_LOCAL_1 (lname, field_name,                      \
1227                                 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, magicfun)
1228 #define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name)                   \
1229         DEFVAR_CONST_CONSOLE_LOCAL_MAGIC (lname, field_name, 0)
1230
1231 #define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun)      \
1232         DEFVAR_SYMVAL_FWD(lname, &(console_local_flags.field_name),     \
1233                           SYMVAL_DEFAULT_CONSOLE_FORWARD, magicfun)
1234 #define DEFVAR_CONSOLE_DEFAULTS(lname, field_name)                      \
1235         DEFVAR_CONSOLE_DEFAULTS_MAGIC (lname, field_name, 0)
1236
1237 static void nuke_all_console_slots(struct console *con, Lisp_Object zap)
1238 {
1239         zero_lcrecord(con);
1240
1241 #define MARKED_SLOT(x)  con->x = zap
1242 #include "conslots.h"
1243 #undef MARKED_SLOT
1244 }
1245
1246 static void common_init_complex_vars_of_console(void)
1247 {
1248         /* Make sure all markable slots in console_defaults
1249            are initialized reasonably, so mark_console won't choke.
1250          */
1251         struct console *defs =
1252             alloc_lcrecord_type(struct console, &lrecord_console);
1253         struct console *syms =
1254             alloc_lcrecord_type(struct console, &lrecord_console);
1255
1256         staticpro_nodump(&Vconsole_defaults);
1257         staticpro_nodump(&Vconsole_local_symbols);
1258         XSETCONSOLE(Vconsole_defaults, defs);
1259         XSETCONSOLE(Vconsole_local_symbols, syms);
1260
1261         nuke_all_console_slots(syms, Qnil);
1262         nuke_all_console_slots(defs, Qnil);
1263
1264         /* Set up the non-nil default values of various console slots.
1265            Must do these before making the first console.
1266          */
1267         /* #### Anything needed here? */
1268
1269         {
1270                 /*  0 means var is always local.  Default used only at creation.
1271                  * -1 means var is always local.  Default used only at reset and
1272                  *    creation.
1273                  * -2 means there's no lisp variable corresponding to this slot
1274                  *    and the default is only used at creation.
1275                  * -3 means no Lisp variable.  Default used only at reset and creation.
1276                  * >0 is mask.  Var is local if ((console->local_var_flags & mask) != 0)
1277                  *              Otherwise default is used.
1278                  *
1279                  * #### We don't currently ever reset console variables, so there
1280                  * is no current distinction between 0 and -1, and between -2 and -3.
1281                  */
1282                 Lisp_Object always_local_resettable = make_int(-1);
1283
1284 #if 0                           /* not used */
1285                 Lisp_Object always_local_no_default = make_int(0);
1286                 Lisp_Object resettable = make_int(-3);
1287 #endif
1288
1289                 /* Assign the local-flags to the slots that have default values.
1290                    The local flag is a bit that is used in the console
1291                    to say that it has its own local value for the slot.
1292                    The local flag bits are in the local_var_flags slot of the
1293                    console.  */
1294
1295                 nuke_all_console_slots(&console_local_flags, make_int(-2));
1296                 console_local_flags.defining_kbd_macro =
1297                     always_local_resettable;
1298                 console_local_flags.last_kbd_macro = always_local_resettable;
1299                 console_local_flags.prefix_arg = always_local_resettable;
1300                 console_local_flags.default_minibuffer_frame =
1301                     always_local_resettable;
1302                 console_local_flags.overriding_terminal_local_map =
1303                     always_local_resettable;
1304 #ifdef HAVE_TTY
1305                 console_local_flags.tty_erase_char = always_local_resettable;
1306 #endif
1307
1308                 console_local_flags.function_key_map = make_int(1);
1309
1310                 /* #### Warning, 0x4000000 (that's six zeroes) is the largest number
1311                    currently allowable due to the XINT() handling of this value.
1312                    With some rearrangement you can get 4 more bits. */
1313         }
1314 }
1315
1316 #define CONSOLE_SLOTS_SIZE (offsetof (struct console, CONSOLE_SLOTS_LAST_NAME) - offsetof (struct console, CONSOLE_SLOTS_FIRST_NAME) + sizeof (Lisp_Object))
1317 #define CONSOLE_SLOTS_COUNT (CONSOLE_SLOTS_SIZE / sizeof (Lisp_Object))
1318
1319 void reinit_complex_vars_of_console(void)
1320 {
1321         struct console *defs, *syms;
1322
1323         common_init_complex_vars_of_console();
1324
1325         defs = XCONSOLE(Vconsole_defaults);
1326         syms = XCONSOLE(Vconsole_local_symbols);
1327         memcpy(&defs->CONSOLE_SLOTS_FIRST_NAME,
1328                console_defaults_saved_slots, CONSOLE_SLOTS_SIZE);
1329         memcpy(&syms->CONSOLE_SLOTS_FIRST_NAME,
1330                console_local_symbols_saved_slots, CONSOLE_SLOTS_SIZE);
1331 }
1332
1333 static const struct lrecord_description console_slots_description_1[] = {
1334         {XD_LISP_OBJECT_ARRAY, 0, CONSOLE_SLOTS_COUNT},
1335         {XD_END}
1336 };
1337
1338 static const struct struct_description console_slots_description = {
1339         CONSOLE_SLOTS_SIZE,
1340         console_slots_description_1
1341 };
1342
1343 void complex_vars_of_console(void)
1344 {
1345         struct console *defs, *syms;
1346
1347         common_init_complex_vars_of_console();
1348
1349         defs = XCONSOLE(Vconsole_defaults);
1350         syms = XCONSOLE(Vconsole_local_symbols);
1351         console_defaults_saved_slots = &defs->CONSOLE_SLOTS_FIRST_NAME;
1352         console_local_symbols_saved_slots = &syms->CONSOLE_SLOTS_FIRST_NAME;
1353         dump_add_root_struct_ptr(&console_defaults_saved_slots,
1354                                  &console_slots_description);
1355         dump_add_root_struct_ptr(&console_local_symbols_saved_slots,
1356                                  &console_slots_description);
1357
1358         DEFVAR_CONSOLE_DEFAULTS("default-function-key-map", function_key_map    /*
1359 Default value of `function-key-map' for consoles that don't override it.
1360 This is the same as (default-value 'function-key-map).
1361                                                                                  */ );
1362
1363         DEFVAR_CONSOLE_LOCAL("function-key-map", function_key_map       /*
1364 Keymap mapping ASCII function key sequences onto their preferred forms.
1365 This allows Emacs to recognize function keys sent from ASCII
1366 terminals at any point in a key sequence.
1367
1368 The `read-key-sequence' function replaces any subsequence bound by
1369 `function-key-map' with its binding.  More precisely, when the active
1370 keymaps have no binding for the current key sequence but
1371 `function-key-map' binds a suffix of the sequence to a vector or string,
1372 `read-key-sequence' replaces the matching suffix with its binding, and
1373 continues with the new sequence.  See `key-binding'.
1374
1375 The events that come from bindings in `function-key-map' are not
1376 themselves looked up in `function-key-map'.
1377
1378 For example, suppose `function-key-map' binds `ESC O P' to [f1].
1379 Typing `ESC O P' to `read-key-sequence' would return
1380 \[#<keypress-event f1>].  Typing `C-x ESC O P' would return
1381 \[#<keypress-event control-X> #<keypress-event f1>].  If [f1]
1382 were a prefix key, typing `ESC O P x' would return
1383 \[#<keypress-event f1> #<keypress-event x>].
1384                                                                          */ );
1385
1386 #ifdef HAVE_TTY
1387         /* #### Should this somehow go to TTY data?  How do we make it
1388            accessible from Lisp, then?  */
1389         DEFVAR_CONSOLE_LOCAL("tty-erase-char", tty_erase_char   /*
1390 The ERASE character as set by the user with stty.
1391 When this value cannot be determined or would be meaningless (on non-TTY
1392 consoles, for example), it is set to nil.
1393                                                                  */ );
1394 #endif
1395
1396         /* While this should be const it can't be because some things
1397            (i.e. edebug) do manipulate it. */
1398         DEFVAR_CONSOLE_LOCAL("defining-kbd-macro", defining_kbd_macro   /*
1399 Non-nil while a keyboard macro is being defined.  Don't set this!
1400                                                                          */ );
1401
1402         DEFVAR_CONSOLE_LOCAL("last-kbd-macro", last_kbd_macro   /*
1403 Last keyboard macro defined, as a vector of events; nil if none defined.
1404                                                                  */ );
1405
1406         DEFVAR_CONSOLE_LOCAL("prefix-arg", prefix_arg   /*
1407 The value of the prefix argument for the next editing command.
1408 It may be a number, or the symbol `-' for just a minus sign as arg,
1409 or a list whose car is a number for just one or more C-U's
1410 or nil if no argument has been specified.
1411
1412 You cannot examine this variable to find the argument for this command
1413 since it has been set to nil by the time you can look.
1414 Instead, you should use the variable `current-prefix-arg', although
1415 normally commands can get this prefix argument with (interactive "P").
1416                                                          */ );
1417
1418         DEFVAR_CONSOLE_LOCAL("default-minibuffer-frame", default_minibuffer_frame       /*
1419 Minibufferless frames use this frame's minibuffer.
1420
1421 Emacs cannot create minibufferless frames unless this is set to an
1422 appropriate surrogate.
1423
1424 SXEmacs consults this variable only when creating minibufferless
1425 frames; once the frame is created, it sticks with its assigned
1426 minibuffer, no matter what this variable is set to.  This means that
1427 this variable doesn't necessarily say anything meaningful about the
1428 current set of frames, or where the minibuffer is currently being
1429 displayed.
1430                                                                                          */ );
1431
1432         DEFVAR_CONSOLE_LOCAL("overriding-terminal-local-map", overriding_terminal_local_map     /*
1433 Keymap that overrides all other local keymaps, for the selected console only.
1434 If this variable is non-nil, it is used as a keymap instead of the
1435 buffer's local map, and the minor mode keymaps and text property keymaps.
1436                                                                                                  */ );
1437
1438         /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding
1439            slot of console_local_flags and vice-versa.  Must be done after all
1440            DEFVAR_CONSOLE_LOCAL() calls. */
1441 #define MARKED_SLOT(slot)                                       \
1442   if ((XINT (console_local_flags.slot) != -2 &&                 \
1443          XINT (console_local_flags.slot) != -3)                 \
1444       != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot)))     \
1445   abort ()
1446 #include "conslots.h"
1447 #undef MARKED_SLOT
1448 }