src/device.c

   1 /* Generic device functions.
   2    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
   3    Copyright (C) 1994, 1995 Free Software Foundation, Inc.
   4    Copyright (C) 1995, 1996 Ben Wing
   5
   6 This file is part of XEmacs.
   7
   8 XEmacs is free software; you can redistribute it and/or modify it
   9 under the terms of the GNU General Public License as published by the
  10 Free Software Foundation; either version 2, or (at your option) any
  11 later version.
  12
  13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with XEmacs; see the file COPYING.  If not, write to
  20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 Boston, MA 02111-1307, USA.  */
  22
  23 /* Synched up with: Not in FSF. */
  24
  25 /* Original version by Chuck Thompson;
  26    rewritten and expanded by Ben Wing. */
  27
  28 #include <config.h>
  29 #include "lisp.h"
  30
  31 #include "buffer.h"
  32 #include "console.h"
  33 #include "device.h"
  34 #include "elhash.h"
  35 #include "events.h"
  36 #include "faces.h"
  37 #include "frame.h"
  38 #include "keymap.h"
  39 #include "redisplay.h"
  40 #include "specifier.h"
  41 #include "sysdep.h"
  42 #include "window.h"
  43
  44 #ifdef HAVE_SCROLLBARS
  45 #include "scrollbar.h"
  46 #endif
  47
  48 #include "syssignal.h"
  49
  50 /* Vdefault_device is the firstly-created non-stream device that's still
  51    around.  We don't really use it anywhere currently, but it might
  52    be used for resourcing at some point.  (Currently we use
  53    Vdefault_x_device.) */
  54 Lisp_Object Vdefault_device;
  55
  56 Lisp_Object Vcreate_device_hook, Vdelete_device_hook;
  57
  58 /* Device classes */
  59 /* Qcolor defined in general.c */
  60 Lisp_Object Qgrayscale, Qmono;
  61
  62 /* Device metrics symbols */
  63 Lisp_Object
  64   Qcolor_default, Qcolor_select, Qcolor_balloon, Qcolor_3d_face,
  65   Qcolor_3d_light, Qcolor_3d_dark, Qcolor_menu, Qcolor_menu_highlight,
  66   Qcolor_menu_button, Qcolor_menu_disabled, Qcolor_toolbar,
  67   Qcolor_scrollbar, Qcolor_desktop, Qcolor_workspace, Qfont_default,
  68   Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar,
  69   Qsize_menu, Qsize_toolbar, Qsize_toolbar_button,
  70   Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device,
  71   Qsize_workspace, Qoffset_workspace, Qsize_device_mm, Qdevice_dpi,
  72   Qnum_bit_planes, Qnum_color_cells, Qmouse_buttons, Qswap_buttons,
  73   Qshow_sounds, Qslow_device, Qsecurity;
  74
  75 Lisp_Object Qdevicep, Qdevice_live_p;
  76 Lisp_Object Qcreate_device_hook;
  77 Lisp_Object Qdelete_device_hook;
  78 Lisp_Object Vdevice_class_list;
  79
  80 \f
  81 static Lisp_Object
  82 mark_device (Lisp_Object obj)
  83 {
  84   struct device *d = XDEVICE (obj);
  85
  86   mark_object (d->name);
  87   mark_object (d->connection);
  88   mark_object (d->canon_connection);
  89   mark_object (d->console);
  90   mark_object (d->selected_frame);
  91   mark_object (d->frame_with_focus_real);
  92   mark_object (d->frame_with_focus_for_hooks);
  93   mark_object (d->frame_that_ought_to_have_focus);
  94   mark_object (d->device_class);
  95   mark_object (d->user_defined_tags);
  96   mark_object (d->pixel_to_glyph_cache.obj1);
  97   mark_object (d->pixel_to_glyph_cache.obj2);
  98
  99   mark_object (d->color_instance_cache);
 100   mark_object (d->font_instance_cache);
 101 #ifdef MULE
 102   mark_object (d->charset_font_cache);
 103 #endif
 104   mark_object (d->image_instance_cache);
 105
 106   if (d->devmeths)
 107     {
 108       mark_object (d->devmeths->symbol);
 109       MAYBE_DEVMETH (d, mark_device, (d));
 110     }
 111
 112   return (d->frame_list);
 113 }
 114
 115 static void
 116 print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 117 {
 118   struct device *d = XDEVICE (obj);
 119   char buf[256];
 120
 121   if (print_readably)
 122     error ("printing unreadable object #<device %s 0x%x>",
 123            XSTRING_DATA (d->name), d->header.uid);
 124
 125   sprintf (buf, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" :
 126            DEVICE_TYPE_NAME (d));
 127   write_c_string (buf, printcharfun);
 128   if (DEVICE_LIVE_P (d) && !NILP (DEVICE_CONNECTION (d)))
 129     {
 130       write_c_string (" on ", printcharfun);
 131       print_internal (DEVICE_CONNECTION (d), printcharfun, 1);
 132     }
 133   sprintf (buf, " 0x%x>", d->header.uid);
 134   write_c_string (buf, printcharfun);
 135 }
 136
 137 DEFINE_LRECORD_IMPLEMENTATION ("device", device,
 138                                mark_device, print_device, 0, 0, 0, 0,
 139                                struct device);
 140 \f
 141 int
 142 valid_device_class_p (Lisp_Object class)
 143 {
 144   return !NILP (memq_no_quit (class, Vdevice_class_list));
 145 }
 146
 147 DEFUN ("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0, /*
 148 Given a DEVICE-CLASS, return t if it is valid.
 149 Valid classes are 'color, 'grayscale, and 'mono.
 150 */
 151        (device_class))
 152 {
 153   return valid_device_class_p (device_class) ? Qt : Qnil;
 154 }
 155
 156 DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /*
 157 Return a list of valid device classes.
 158 */
 159        ())
 160 {
 161   return Fcopy_sequence (Vdevice_class_list);
 162 }
 163
 164 static struct device *
 165 allocate_device (Lisp_Object console)
 166 {
 167   Lisp_Object device;
 168   struct device *d = alloc_lcrecord_type (struct device, &lrecord_device);
 169   struct gcpro gcpro1;
 170
 171   zero_lcrecord (d);
 172
 173   XSETDEVICE (device, d);
 174   GCPRO1 (device);
 175
 176   d->name = Qnil;
 177   d->console = console;
 178   d->connection = Qnil;
 179   d->canon_connection = Qnil;
 180   d->frame_list = Qnil;
 181   d->selected_frame = Qnil;
 182   d->frame_with_focus_real = Qnil;
 183   d->frame_with_focus_for_hooks = Qnil;
 184   d->frame_that_ought_to_have_focus = Qnil;
 185   d->device_class = Qnil;
 186   d->user_defined_tags = Qnil;
 187   d->pixel_to_glyph_cache.obj1 = Qnil;
 188   d->pixel_to_glyph_cache.obj2 = Qnil;
 189
 190   d->infd = d->outfd = -1;
 191
 192   /* #### is 20 reasonable? */
 193   d->color_instance_cache =
 194     make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL);
 195   d->font_instance_cache =
 196     make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL);
 197 #ifdef MULE
 198   /* Note that the following table is bi-level. */
 199   d->charset_font_cache =
 200     make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
 201 #endif
 202   /*
 203      Note that the image instance cache is actually bi-level.
 204      See device.h.  We use a low number here because most of the
 205      time there aren't very many different masks that will be used.
 206      */
 207   d->image_instance_cache =
 208     make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
 209
 210   UNGCPRO;
 211   return d;
 212 }
 213
 214 struct device *
 215 decode_device (Lisp_Object device)
 216 {
 217   if (NILP (device))
 218     device = Fselected_device (Qnil);
 219   /* quietly accept frames for the device arg */
 220   else if (FRAMEP (device))
 221     device = FRAME_DEVICE (decode_frame (device));
 222   CHECK_LIVE_DEVICE (device);
 223   return XDEVICE (device);
 224 }
 225
 226 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /*
 227 Given a device, frame, or window, return the associated device.
 228 Return nil otherwise.
 229 */
 230        (object))
 231 {
 232   return DFW_DEVICE (object);
 233 }
 234
 235 \f
 236 DEFUN ("selected-device", Fselected_device, 0, 1, 0, /*
 237 Return the device which is currently active.
 238 If optional CONSOLE is non-nil, return the device that would be currently
 239 active if CONSOLE were the selected console.
 240 */
 241        (console))
 242 {
 243   if (NILP (console) && NILP (Vselected_console))
 244     return Qnil; /* happens early in temacs */
 245   return CONSOLE_SELECTED_DEVICE (decode_console (console));
 246 }
 247
 248 /* Called from selected_frame_1(), called from Fselect_window() */
 249 void
 250 select_device_1 (Lisp_Object device)
 251 {
 252   struct device *dev = XDEVICE (device);
 253   Lisp_Object old_selected_device = Fselected_device (Qnil);
 254
 255   if (EQ (device, old_selected_device))
 256     return;
 257
 258   /* now select the device's console */
 259   CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (dev))) = device;
 260   select_console_1 (DEVICE_CONSOLE (dev));
 261 }
 262
 263 DEFUN ("select-device", Fselect_device, 1, 1, 0, /*
 264 Select the device DEVICE.
 265 Subsequent editing commands apply to its console, selected frame,
 266 and selected window.
 267 The selection of DEVICE lasts until the next time the user does
 268 something to select a different device, or until the next time this
 269 function is called.
 270 */
 271        (device))
 272 {
 273   CHECK_LIVE_DEVICE (device);
 274
 275   /* select the device's selected frame's selected window.  This will call
 276      selected_frame_1()->selected_device_1()->selected_console_1(). */
 277   if (!NILP (DEVICE_SELECTED_FRAME (XDEVICE (device))))
 278     Fselect_window (FRAME_SELECTED_WINDOW
 279                     (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device)))),
 280                     Qnil);
 281   else
 282     error ("Can't select a device with no frames");
 283   return Qnil;
 284 }
 285
 286 void
 287 set_device_selected_frame (struct device *d, Lisp_Object frame)
 288 {
 289   if (!NILP (frame) && !FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
 290     set_console_last_nonminibuf_frame (XCONSOLE (DEVICE_CONSOLE (d)), frame);
 291   d->selected_frame = frame;
 292 }
 293
 294 DEFUN ("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /*
 295 Set the selected frame of device object DEVICE to FRAME.
 296 If DEVICE is nil, the selected device is used.
 297 If DEVICE is the selected device, this makes FRAME the selected frame.
 298 */
 299        (device, frame))
 300 {
 301   XSETDEVICE (device, decode_device (device));
 302   CHECK_LIVE_FRAME (frame);
 303
 304   if (! EQ (device, FRAME_DEVICE (XFRAME (frame))))
 305     error ("In `set-device-selected-frame', FRAME is not on DEVICE");
 306
 307   if (EQ (device, Fselected_device (Qnil)))
 308     return Fselect_frame (frame);
 309
 310   set_device_selected_frame (XDEVICE (device), frame);
 311   return frame;
 312 }
 313
 314 DEFUN ("devicep", Fdevicep, 1, 1, 0, /*
 315 Return non-nil if OBJECT is a device.
 316 */
 317        (object))
 318 {
 319   return DEVICEP (object) ? Qt : Qnil;
 320 }
 321
 322 DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /*
 323 Return non-nil if OBJECT is a device that has not been deleted.
 324 */
 325        (object))
 326 {
 327   return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil;
 328 }
 329
 330 DEFUN ("device-name", Fdevice_name, 0, 1, 0, /*
 331 Return the name of the specified device.
 332 DEVICE defaults to the selected device if omitted.
 333 */
 334        (device))
 335 {
 336   return DEVICE_NAME (decode_device (device));
 337 }
 338
 339 DEFUN ("device-connection", Fdevice_connection, 0, 1, 0, /*
 340 Return the connection of the specified device.
 341 DEVICE defaults to the selected device if omitted.
 342 */
 343        (device))
 344 {
 345   return DEVICE_CONNECTION (decode_device (device));
 346 }
 347
 348 DEFUN ("device-console", Fdevice_console, 0, 1, 0, /*
 349 Return the console of the specified device.
 350 DEVICE defaults to the selected device if omitted.
 351 */
 352        (device))
 353 {
 354   return DEVICE_CONSOLE (decode_device (device));
 355 }
 356
 357 #ifdef HAVE_WINDOW_SYSTEM
 358
 359 static void
 360 init_global_resources (struct device *d)
 361 {
 362   init_global_faces (d);
 363 #ifdef HAVE_SCROLLBARS
 364   init_global_scrollbars (d);
 365 #endif
 366 #ifdef HAVE_TOOLBARS
 367   init_global_toolbars (d);
 368 #endif
 369 }
 370
 371 #endif
 372
 373 static void
 374 init_device_resources (struct device *d)
 375 {
 376   init_device_faces (d);
 377 #ifdef HAVE_SCROLLBARS
 378   init_device_scrollbars (d);
 379 #endif
 380 #ifdef HAVE_TOOLBARS
 381   init_device_toolbars (d);
 382 #endif
 383 }
 384
 385 static Lisp_Object
 386 semi_canonicalize_device_connection (struct console_methods *meths,
 387                                      Lisp_Object name, Error_behavior errb)
 388 {
 389   if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_device_connection))
 390     return CONTYPE_METH (meths, semi_canonicalize_device_connection,
 391                          (name, errb));
 392   else
 393     return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection,
 394                                   (name, errb), name);
 395 }
 396
 397 static Lisp_Object
 398 canonicalize_device_connection (struct console_methods *meths,
 399                                 Lisp_Object name, Error_behavior errb)
 400 {
 401   if (HAS_CONTYPE_METH_P (meths, canonicalize_device_connection))
 402     return CONTYPE_METH (meths, canonicalize_device_connection,
 403                          (name, errb));
 404   else
 405     return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection,
 406                                   (name, errb), name);
 407 }
 408
 409 static Lisp_Object
 410 find_device_of_type (struct console_methods *meths, Lisp_Object canon)
 411 {
 412   Lisp_Object devcons, concons;
 413
 414   DEVICE_LOOP_NO_BREAK (devcons, concons)
 415     {
 416       Lisp_Object device = XCAR (devcons);
 417
 418       if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device)))
 419           && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)),
 420                              canon, 0))
 421         return device;
 422     }
 423
 424   return Qnil;
 425 }
 426
 427 DEFUN ("find-device", Ffind_device, 1, 2, 0, /*
 428 Look for an existing device attached to connection CONNECTION.
 429 Return the device if found; otherwise, return nil.
 430
 431 If TYPE is specified, only return devices of that type; otherwise,
 432 return devices of any type. (It is possible, although unlikely,
 433 that two devices of different types could have the same connection
 434 name; in such a case, the first device found is returned.)
 435 */
 436        (connection, type))
 437 {
 438   Lisp_Object canon = Qnil;
 439   struct gcpro gcpro1;
 440
 441   GCPRO1 (canon);
 442
 443   if (!NILP (type))
 444     {
 445       struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
 446       canon = canonicalize_device_connection (conmeths, connection,
 447                                               ERROR_ME_NOT);
 448       if (UNBOUNDP (canon))
 449         RETURN_UNGCPRO (Qnil);
 450
 451       RETURN_UNGCPRO (find_device_of_type (conmeths, canon));
 452     }
 453   else
 454     {
 455       int i;
 456
 457       for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
 458         {
 459           struct console_methods *conmeths =
 460             Dynarr_at (the_console_type_entry_dynarr, i).meths;
 461           canon = canonicalize_device_connection (conmeths, connection,
 462                                                   ERROR_ME_NOT);
 463           if (!UNBOUNDP (canon))
 464             {
 465               Lisp_Object device = find_device_of_type (conmeths, canon);
 466               if (!NILP (device))
 467                 RETURN_UNGCPRO (device);
 468             }
 469         }
 470
 471       RETURN_UNGCPRO (Qnil);
 472     }
 473 }
 474
 475 DEFUN ("get-device", Fget_device, 1, 2, 0, /*
 476 Look for an existing device attached to connection CONNECTION.
 477 Return the device if found; otherwise, signal an error.
 478
 479 If TYPE is specified, only return devices of that type; otherwise,
 480 return devices of any type. (It is possible, although unlikely,
 481 that two devices of different types could have the same connection
 482 name; in such a case, the first device found is returned.)
 483 */
 484        (connection, type))
 485 {
 486   Lisp_Object device = Ffind_device (connection, type);
 487   if (NILP (device))
 488     {
 489       if (NILP (type))
 490         signal_simple_error ("No such device", connection);
 491       else
 492         signal_simple_error_2 ("No such device", type, connection);
 493     }
 494   return device;
 495 }
 496
 497 static Lisp_Object
 498 delete_deviceless_console (Lisp_Object console)
 499 {
 500   if (NILP (XCONSOLE (console)->device_list))
 501     Fdelete_console (console, Qnil);
 502   return Qnil;
 503 }
 504
 505 DEFUN ("make-device", Fmake_device, 2, 3, 0, /*
 506 Return a new device of type TYPE, attached to connection CONNECTION.
 507
 508 The valid values for CONNECTION are device-specific; however,
 509 CONNECTION is generally a string. (Specifically, for X devices,
 510 CONNECTION should be a display specification such as "foo:0", and
 511 for TTY devices, CONNECTION should be the filename of a TTY device
 512 file, such as "/dev/ttyp4", or nil to refer to XEmacs' standard
 513 input/output.)
 514
 515 PROPS, if specified, should be a plist of properties controlling
 516 device creation.
 517
 518 If CONNECTION specifies an already-existing device connection, that
 519 device is simply returned; no new device is created, and PROPS
 520 have no effect.
 521 */
 522        (type, connection, props))
 523 {
 524   /* This function can GC */
 525   struct device *d;
 526   struct console *con;
 527   Lisp_Object device = Qnil;
 528   Lisp_Object console = Qnil;
 529   Lisp_Object name = Qnil;
 530   struct console_methods *conmeths;
 531   int speccount = specpdl_depth();
 532
 533   struct gcpro gcpro1, gcpro2, gcpro3;
 534 #ifdef HAVE_X_WINDOWS
 535   /* #### icky-poo.  If this is the first X device we are creating,
 536      then retrieve the global face resources.  We have to do it
 537      here, at the same time as (or just before) the device face
 538      resources are retrieved; specifically, it needs to be done
 539      after the device has been created but before any frames have
 540      been popped up or much anything else has been done.  It's
 541      possible for other devices to specify different global
 542      resources (there's a property on each X server's root window
 543      that holds some resources); tough luck for the moment.
 544
 545      This is a nasty violation of device independence, but
 546      there's not a whole lot I can figure out to do about it.
 547      The real problem is that the concept of resources is not
 548      generalized away from X.  Similar resource-related
 549      device-independence violations occur in faces.el. */
 550   int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx);
 551 #endif
 552 #ifdef HAVE_GTK
 553   int first_gtk_device = NILP (Vdefault_gtk_device) && EQ (type, Qgtk);
 554 #endif
 555
 556   GCPRO3 (device, console, name);
 557
 558   conmeths = decode_console_type (type, ERROR_ME_NOT);
 559   if (!conmeths)
 560     signal_simple_error ("Invalid device type", type);
 561
 562   device = Ffind_device (connection, type);
 563   if (!NILP (device))
 564     RETURN_UNGCPRO (device);
 565
 566   name = Fplist_get (props, Qname, Qnil);
 567
 568   {
 569     Lisp_Object conconnect =
 570       (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ?
 571       CONTYPE_METH (conmeths, device_to_console_connection,
 572                     (connection, ERROR_ME)) :
 573       connection;
 574     console = create_console (name, type, conconnect, props);
 575   }
 576
 577   record_unwind_protect(delete_deviceless_console, console);
 578
 579   con = XCONSOLE (console);
 580   d = allocate_device (console);
 581   XSETDEVICE (device, d);
 582
 583   d->devmeths = con->conmeths;
 584
 585   DEVICE_NAME (d) = name;
 586   DEVICE_CONNECTION (d) =
 587     semi_canonicalize_device_connection (conmeths, connection, ERROR_ME);
 588   DEVICE_CANON_CONNECTION (d) =
 589     canonicalize_device_connection (conmeths, connection, ERROR_ME);
 590
 591   MAYBE_DEVMETH (d, init_device, (d, props));
 592
 593   /* Do it this way so that the device list is in order of creation */
 594   con->device_list = nconc2 (con->device_list, Fcons (device, Qnil));
 595   RESET_CHANGED_SET_FLAGS;
 596   if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device)))
 597     Vdefault_device = device;
 598
 599   init_device_sound (d);
 600 #ifdef HAVE_X_WINDOWS
 601   if (first_x_device)
 602     init_global_resources (d);
 603 #endif
 604 #ifdef HAVE_GTK
 605   if (first_gtk_device)
 606     init_global_resources (d);
 607 #endif
 608   init_device_resources (d);
 609
 610   MAYBE_DEVMETH (d, finish_init_device, (d, props));
 611
 612   /* If this is the first device on the console, make it the selected one. */
 613   if (NILP (CONSOLE_SELECTED_DEVICE (con)))
 614     CONSOLE_SELECTED_DEVICE (con) = device;
 615
 616   /* #### the following should trap errors. */
 617   setup_device_initial_specifier_tags (d);
 618
 619   UNGCPRO;
 620   unbind_to(speccount, Qnil);
 621   return device;
 622 }
 623
 624 /* find a device other than the selected one.  Prefer non-stream
 625    devices over stream devices.  Maybe stay on the same console. */
 626
 627 static Lisp_Object
 628 find_other_device (Lisp_Object device, int on_same_console)
 629 {
 630   Lisp_Object devcons = Qnil, concons;
 631   Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device));
 632
 633   /* look for a non-stream device */
 634   DEVICE_LOOP_NO_BREAK (devcons, concons)
 635     {
 636       Lisp_Object dev = XCAR (devcons);
 637       if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
 638         continue;
 639       if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) &&
 640           !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
 641         goto double_break_1;
 642     }
 643
 644  double_break_1:
 645   if (!NILP (devcons))
 646     return XCAR (devcons);
 647
 648   /* OK, now look for a stream device */
 649   DEVICE_LOOP_NO_BREAK (devcons, concons)
 650     {
 651       Lisp_Object dev = XCAR (devcons);
 652       if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
 653         continue;
 654       if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
 655         goto double_break_2;
 656     }
 657  double_break_2:
 658   if (!NILP (devcons))
 659     return XCAR (devcons);
 660
 661   /* Sorry, there ain't none */
 662   return Qnil;
 663 }
 664
 665 static int
 666 find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame,
 667                                                   void *closure)
 668 {
 669   Lisp_Object device;
 670
 671   VOID_TO_LISP (device, closure);
 672   if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
 673     return 0;
 674   if (EQ (device, FRAME_DEVICE (XFRAME (frame))))
 675     return 0;
 676   return 1;
 677 }
 678
 679 Lisp_Object
 680 find_nonminibuffer_frame_not_on_device (Lisp_Object device)
 681 {
 682   return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate,
 683                           LISP_TO_VOID (device));
 684 }
 685
 686
 687 /* Delete device D.
 688
 689    If FORCE is non-zero, allow deletion of the only frame.
 690
 691    If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if
 692    deleting the last device on a console, just delete it,
 693    instead of calling `delete-console'.
 694
 695    If FROM_IO_ERROR is non-zero, then the device is gone due
 696    to an I/O error.  This affects what happens if we exit
 697    (we do an emergency exit instead of `save-buffers-kill-emacs'.)
 698 */
 699
 700 void
 701 delete_device_internal (struct device *d, int force,
 702                         int called_from_delete_console,
 703                         int from_io_error)
 704 {
 705   /* This function can GC */
 706   struct console *c;
 707   Lisp_Object device;
 708   struct gcpro gcpro1;
 709
 710   /* OK to delete an already-deleted device. */
 711   if (!DEVICE_LIVE_P (d))
 712     return;
 713
 714   XSETDEVICE (device, d);
 715   GCPRO1 (device);
 716
 717   c = XCONSOLE (DEVICE_CONSOLE (d));
 718
 719   if (!called_from_delete_console)
 720     {
 721       int delete_console = 0;
 722       /* If we're deleting the only device on the console,
 723          delete the console. */
 724       if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1)
 725           /* if we just created the device, it might not be listed,
 726              or something ... */
 727           && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c))))
 728         delete_console = 1;
 729       /* Or if there aren't any nonminibuffer frames that would be
 730          left, delete the console (this will make XEmacs exit). */
 731       else if (NILP (find_nonminibuffer_frame_not_on_device (device)))
 732         delete_console = 1;
 733
 734       if (delete_console)
 735         {
 736           delete_console_internal (c, force, 0, from_io_error);
 737           UNGCPRO;
 738           return;
 739         }
 740     }
 741
 742   reset_one_device (d);
 743
 744   {
 745     Lisp_Object frmcons;
 746
 747     /* First delete all frames without their own minibuffers,
 748        to avoid errors coming from attempting to delete a frame
 749        that is a surrogate for another frame. */
 750     DEVICE_FRAME_LOOP (frmcons, d)
 751       {
 752         struct frame *f = XFRAME (XCAR (frmcons));
 753         /* delete_frame_internal() might do anything such as run hooks,
 754            so be defensive. */
 755         if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
 756           delete_frame_internal (f, 1, 1, from_io_error);
 757
 758         if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
 759                                    go ahead and delete anything */
 760           {
 761             UNGCPRO;
 762             return;
 763           }
 764       }
 765
 766     /* #### This should probably be a device method but it is time for
 767        19.14 to go out the door. */
 768     /* #### BILL!!! Should this deal with HAVE_MSWINDOWS as well? */
 769 #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK)
 770     /* Next delete all frames which have the popup property to avoid
 771        deleting a child after its parent. */
 772     DEVICE_FRAME_LOOP (frmcons, d)
 773       {
 774         struct frame *f = XFRAME (XCAR (frmcons));
 775
 776         if (FRAME_LIVE_P (f))
 777           {
 778             Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil);
 779             if (!NILP (popup))
 780               delete_frame_internal (f, 1, 1, from_io_error);
 781
 782             if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
 783                                        go ahead and delete anything */
 784               {
 785                 UNGCPRO;
 786                 return;
 787               }
 788           }
 789       }
 790 #endif /* HAVE_X_WINDOWS */
 791
 792     DEVICE_FRAME_LOOP (frmcons, d)
 793       {
 794         struct frame *f = XFRAME (XCAR (frmcons));
 795         /* delete_frame_internal() might do anything such as run hooks,
 796            so be defensive. */
 797         if (FRAME_LIVE_P (f))
 798           delete_frame_internal (f, 1, 1, from_io_error);
 799
 800         if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
 801                                    go ahead and delete anything */
 802           {
 803             UNGCPRO;
 804             return;
 805           }
 806       }
 807   }
 808
 809   set_device_selected_frame (d, Qnil);
 810
 811   /* try to select another device */
 812
 813   if (EQ (device, Fselected_device (DEVICE_CONSOLE (d))))
 814     {
 815       Lisp_Object other_dev = find_other_device (device, 1);
 816       if (!NILP (other_dev))
 817         Fselect_device (other_dev);
 818     }
 819
 820   if (EQ (device, Vdefault_device))
 821     Vdefault_device = find_other_device (device, 0);
 822
 823   MAYBE_DEVMETH (d, delete_device, (d));
 824
 825   CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c));
 826   RESET_CHANGED_SET_FLAGS;
 827   d->devmeths = dead_console_methods;
 828   UNGCPRO;
 829 }
 830
 831 /* delete a device as a result of an I/O error.  Called from
 832    an enqueued magic-eval event. */
 833
 834 void
 835 io_error_delete_device (Lisp_Object device)
 836 {
 837   /* Note: it's the console that should get deleted, but
 838      delete_device_internal() contains a hack that also deletes the
 839      console when called from this function.  */
 840   delete_device_internal (XDEVICE (device), 1, 0, 1);
 841 }
 842
 843 DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /*
 844 Delete DEVICE, permanently eliminating it from use.
 845 Normally, you cannot delete the last non-minibuffer-only frame (you must
 846 use `save-buffers-kill-emacs' or `kill-emacs').  However, if optional
 847 second argument FORCE is non-nil, you can delete the last frame. (This
 848 will automatically call `save-buffers-kill-emacs'.)
 849 */
 850        (device, force))
 851 {
 852   CHECK_DEVICE (device);
 853   delete_device_internal (XDEVICE (device), !NILP (force), 0, 0);
 854   return Qnil;
 855 }
 856
 857 DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /*
 858 Return a list of all frames on DEVICE.
 859 If DEVICE is nil, the selected device will be used.
 860 */
 861        (device))
 862 {
 863   return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device)));
 864 }
 865
 866 DEFUN ("device-class", Fdevice_class, 0, 1, 0, /*
 867 Return the class (color behavior) of DEVICE.
 868 This will be one of 'color, 'grayscale, or 'mono.
 869 */
 870        (device))
 871 {
 872   return DEVICE_CLASS (decode_device (device));
 873 }
 874
 875 DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /*
 876 Set the class (color behavior) of DEVICE.
 877 CLASS should be one of 'color, 'grayscale, or 'mono.
 878 This is only allowed on device such as TTY devices, where the color
 879 behavior cannot necessarily be determined automatically.
 880 */
 881        (device, class))
 882 {
 883   struct device *d = decode_device (device);
 884   XSETDEVICE (device, d);
 885   if (!DEVICE_TTY_P (d))
 886     signal_simple_error ("Cannot change the class of this device", device);
 887   if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale))
 888     signal_simple_error ("Must be color, mono, or grayscale", class);
 889   if (! EQ (DEVICE_CLASS (d), class))
 890     {
 891       Lisp_Object frmcons;
 892       DEVICE_CLASS (d) = class;
 893       DEVICE_FRAME_LOOP (frmcons, d)
 894         {
 895           struct frame *f = XFRAME (XCAR (frmcons));
 896
 897           recompute_all_cached_specifiers_in_frame (f);
 898           MARK_FRAME_FACES_CHANGED (f);
 899           MARK_FRAME_GLYPHS_CHANGED (f);
 900           MARK_FRAME_SUBWINDOWS_CHANGED (f);
 901           MARK_FRAME_TOOLBARS_CHANGED (f);
 902           MARK_FRAME_GUTTERS_CHANGED (f);
 903           f->menubar_changed = 1;
 904         }
 905     }
 906   return Qnil;
 907 }
 908
 909 DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /*
 910 Set the output baud rate of DEVICE to RATE.
 911 On most systems, changing this value will affect the amount of padding
 912 and other strategic decisions made during redisplay.
 913 */
 914        (device, rate))
 915 {
 916   CHECK_INT (rate);
 917
 918   DEVICE_BAUD_RATE (decode_device (device)) = XINT (rate);
 919
 920   return rate;
 921 }
 922
 923 DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /*
 924 Return the output baud rate of DEVICE.
 925 */
 926        (device))
 927 {
 928   return make_int (DEVICE_BAUD_RATE (decode_device (device)));
 929 }
 930
 931 DEFUN ("device-printer-p", Fdevice_printer_p, 0, 1, 0, /*
 932 Return t if DEVICE is a printer, nil if it is a display. DEVICE defaults
 933 to selected device if omitted, and must be live if specified.
 934 */
 935        (device))
 936 {
 937   return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil;
 938 }
 939
 940 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
 941 Get a metric for DEVICE as provided by the system.
 942
 943 METRIC must be a symbol specifying requested metric.  Note that the metrics
 944 returned are these provided by the system internally, not read from resources,
 945 so obtained from the most internal level.
 946
 947 If a metric is not provided by the system, then DEFAULT is returned.
 948
 949 When DEVICE is nil, selected device is assumed
 950
 951 Metrics, by group, are:
 952
 953 COLORS.  Colors are returned as valid color instantiators.  No other assumption
 954 on the returned value should be made (i.e. it can be a string on one system but
 955 a color instance on another).  For colors, returned value is a cons of
 956 foreground and background colors.  Note that if the system provides only one
 957 color of the pair, the second one may be nil.
 958
 959 color-default         Standard window text foreground and background.
 960 color-select          Selection highlight text and background colors.
 961 color-balloon         Balloon popup text and background colors.
 962 color-3d-face         3-D object (button, modeline) text and surface colors.
 963 color-3d-light        Fore and back colors for 3-D edges facing light source.
 964 color-3d-dark         Fore and back colors for 3-D edges facing away from
 965                       light source.
 966 color-menu            Text and background for menus
 967 color-menu-highlight  Selected menu item colors
 968 color-menu-button     Menu button colors
 969 color-menu-disabled   Unselectable menu item colors
 970 color-toolbar         Toolbar foreground and background colors
 971 color-scrollbar       Scrollbar foreground and background colors
 972 color-desktop         Desktop window colors
 973 color-workspace       Workspace window colors
 974
 975 FONTS. Fonts are returned as valid font instantiators.  No other assumption on
 976 the returned value should be made (i.e. it can be a string on one system but
 977 font instance on another).
 978
 979 font-default          Default fixed width font.
 980 font-menubar          Menubar font
 981 font-dialog           Dialog boxes font
 982
 983 GEOMETRY. These metrics are returned as conses of (X . Y).  As with colors,
 984 either car or cdr of the cons may be nil if the system does not provide one
 985 of the corresponding dimensions.
 986
 987 size-cursor           Mouse cursor size.
 988 size-scrollbar        Scrollbars (WIDTH . HEIGHT)
 989 size-menu             Menubar height, as (nil . HEIGHT)
 990 size-toolbar          Toolbar width and height.
 991 size-toolbar-button   Toolbar button size.
 992 size-toolbar-border   Toolbar border width and height.
 993 size-icon             Icon dimensions.
 994 size-icon-small       Small icon dimensions.
 995 size-device           Device screen or paper size in pixels.
 996 size-workspace        Workspace size in pixels. This can be less than or
 997                       equal to the above. For displays, this is the area
 998                       available to applications less window manager
 999                       decorations. For printers, this is the size of
1000                       printable area.
1001 offset-workspace      Offset of workspace area from the top left corner
1002                       of screen or paper, in pixels.
1003 size-device-mm        Device screen size in millimeters.
1004 device-dpi            Device resolution, in dots per inch.
1005 num-bit-planes        Integer, number of device bit planes.
1006 num-color-cells       Integer, number of device color cells.
1007
1008 FEATURES.  This group reports various device features.  If a feature is
1009 present, integer 1 (one) is returned, if it is not present, then integer
1010 0 (zero) is returned.  If the system is unaware of the feature, then
1011 DEFAULT is returned.
1012
1013 mouse-buttons         Integer, number of mouse buttons, or zero if no mouse.
1014 swap-buttons          Non-zero if left and right mouse buttons are swapped.
1015 show-sounds           User preference for visual over audible bell.
1016 slow-device           Device is slow, avoid animation.
1017 security              Non-zero if user environment is secure.
1018 */
1019        (device, metric, default_))
1020 {
1021   struct device *d = decode_device (device);
1022   enum device_metrics m;
1023   Lisp_Object res;
1024
1025   /* Decode metric */
1026 #define FROB(met)                               \
1027   else if (EQ (metric, Q##met))                 \
1028     m = DM_##met
1029
1030   if (0)
1031     ;
1032   FROB (color_default);
1033   FROB (color_select);
1034   FROB (color_balloon);
1035   FROB (color_3d_face);
1036   FROB (color_3d_light);
1037   FROB (color_3d_dark);
1038   FROB (color_menu);
1039   FROB (color_menu_highlight);
1040   FROB (color_menu_button);
1041   FROB (color_menu_disabled);
1042   FROB (color_toolbar);
1043   FROB (color_scrollbar);
1044   FROB (color_desktop);
1045   FROB (color_workspace);
1046   FROB (font_default);
1047   FROB (font_menubar);
1048   FROB (font_dialog);
1049   FROB (size_cursor);
1050   FROB (size_scrollbar);
1051   FROB (size_menu);
1052   FROB (size_toolbar);
1053   FROB (size_toolbar_button);
1054   FROB (size_toolbar_border);
1055   FROB (size_icon);
1056   FROB (size_icon_small);
1057   FROB (size_device);
1058   FROB (size_workspace);
1059   FROB (offset_workspace);
1060   FROB (size_device_mm);
1061   FROB (device_dpi);
1062   FROB (num_bit_planes);
1063   FROB (num_color_cells);
1064   FROB (mouse_buttons);
1065   FROB (swap_buttons);
1066   FROB (show_sounds);
1067   FROB (slow_device);
1068   FROB (security);
1069   else
1070     signal_simple_error ("Invalid device metric symbol", metric);
1071
1072   res = DEVMETH_OR_GIVEN (d, device_system_metrics, (d, m), Qunbound);
1073   return UNBOUNDP(res) ? default_ : res;
1074
1075 #undef FROB
1076 }
1077
1078 DEFUN ("device-system-metrics", Fdevice_system_metrics, 0, 1, 0, /*
1079 Get a property list of device metric for DEVICE.
1080
1081 See `device-system-metric' for the description of available metrics.
1082 DEVICE defaults to selected device when omitted.
1083 */
1084        (device))
1085 {
1086   struct device *d = decode_device (device);
1087   Lisp_Object plist = Qnil, one_metric;
1088
1089 #define FROB(m)                                                         \
1090   if (!UNBOUNDP ((one_metric =                                          \
1091                   DEVMETH_OR_GIVEN (d, device_system_metrics,           \
1092                                     (d, DM_##m), Qunbound))))           \
1093     plist = Fcons (Q##m, Fcons (one_metric, plist));
1094
1095   FROB (color_default);
1096   FROB (color_select);
1097   FROB (color_balloon);
1098   FROB (color_3d_face);
1099   FROB (color_3d_light);
1100   FROB (color_3d_dark);
1101   FROB (color_menu);
1102   FROB (color_menu_highlight);
1103   FROB (color_menu_button);
1104   FROB (color_menu_disabled);
1105   FROB (color_toolbar);
1106   FROB (color_scrollbar);
1107   FROB (color_desktop);
1108   FROB (color_workspace);
1109   FROB (font_default);
1110   FROB (font_menubar);
1111   FROB (font_dialog);
1112   FROB (size_cursor);
1113   FROB (size_scrollbar);
1114   FROB (size_menu);
1115   FROB (size_toolbar);
1116   FROB (size_toolbar_button);
1117   FROB (size_toolbar_border);
1118   FROB (size_icon);
1119   FROB (size_icon_small);
1120   FROB (size_device);
1121   FROB (size_workspace);
1122   FROB (offset_workspace);
1123   FROB (size_device_mm);
1124   FROB (device_dpi);
1125   FROB (num_bit_planes);
1126   FROB (num_color_cells);
1127   FROB (mouse_buttons);
1128   FROB (swap_buttons);
1129   FROB (show_sounds);
1130   FROB (slow_device);
1131   FROB (security);
1132
1133   return plist;
1134
1135 #undef FROB
1136 }
1137
1138 Lisp_Object
1139 domain_device_type (Lisp_Object domain)
1140 {
1141   /* This cannot GC */
1142   assert (WINDOWP (domain) || FRAMEP (domain)
1143           || DEVICEP (domain) || CONSOLEP (domain));
1144
1145   if (WINDOWP (domain))
1146     {
1147       if (!WINDOW_LIVE_P (XWINDOW (domain)))
1148         return Qdead;
1149       domain = WINDOW_FRAME (XWINDOW (domain));
1150     }
1151   if (FRAMEP (domain))
1152     {
1153       if (!FRAME_LIVE_P (XFRAME (domain)))
1154         return Qdead;
1155       domain = FRAME_DEVICE (XFRAME (domain));
1156     }
1157   if (DEVICEP (domain))
1158     {
1159       if (!DEVICE_LIVE_P (XDEVICE (domain)))
1160         return Qdead;
1161       domain = DEVICE_CONSOLE (XDEVICE (domain));
1162     }
1163   return CONSOLE_TYPE (XCONSOLE (domain));
1164 }
1165
1166 /*
1167  * Determine whether window system bases window geometry on character
1168  * or pixel counts.
1169  * Return non-zero for pixel-based geometry, zero for character-based.
1170  */
1171 int
1172 window_system_pixelated_geometry (Lisp_Object domain)
1173 {
1174   /* This cannot GC */
1175   Lisp_Object winsy = domain_device_type (domain);
1176   struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT);
1177   assert (meth);
1178   return CONMETH_IMPL_FLAG (meth, XDEVIMPF_PIXEL_GEOMETRY);
1179 }
1180
1181 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /*
1182 Return the device type symbol for a DOMAIN, e.g. 'x or 'tty.
1183 DOMAIN can be either a window, frame, device or console.
1184 */
1185        (domain))
1186 {
1187   if (!WINDOWP (domain) && !FRAMEP (domain)
1188       && !DEVICEP (domain) && !CONSOLEP (domain))
1189     signal_simple_error
1190       ("Domain must be either a window, frame, device or console", domain);
1191
1192   return domain_device_type (domain);
1193 }
1194
1195 void
1196 handle_asynch_device_change (void)
1197 {
1198   int i;
1199   int old_asynch_device_change_pending = asynch_device_change_pending;
1200   for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
1201     {
1202       if (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1203           asynch_device_change_method)
1204         (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1205          asynch_device_change_method) ();
1206     }
1207   /* reset the flag to 0 unless another notification occurred while
1208      we were processing this one.  Block SIGWINCH during this
1209      check to prevent a possible race condition. */
1210 #ifdef SIGWINCH
1211   EMACS_BLOCK_SIGNAL (SIGWINCH);
1212 #endif
1213   if (old_asynch_device_change_pending == asynch_device_change_pending)
1214     asynch_device_change_pending = 0;
1215 #ifdef SIGWINCH
1216   EMACS_UNBLOCK_SIGNAL (SIGWINCH);
1217 #endif
1218 }
1219
1220 void
1221 call_critical_lisp_code (struct device *d, Lisp_Object function,
1222                          Lisp_Object object)
1223 {
1224   int old_gc_currently_forbidden = gc_currently_forbidden;
1225   Lisp_Object old_inhibit_quit = Vinhibit_quit;
1226
1227   /* There's no reason to bother doing specbinds here, because if
1228      initialize-*-faces signals an error, emacs is going to crash
1229      immediately.
1230      */
1231   gc_currently_forbidden = 1;
1232   Vinhibit_quit = Qt;
1233   LOCK_DEVICE (d);
1234
1235   /* But it's useful to have an error handler; otherwise an infinite
1236      loop may result. */
1237   if (!NILP (object))
1238     call1_with_handler (Qreally_early_error_handler, function, object);
1239   else
1240     call0_with_handler (Qreally_early_error_handler, function);
1241
1242   UNLOCK_DEVICE (d);
1243   Vinhibit_quit = old_inhibit_quit;
1244   gc_currently_forbidden = old_gc_currently_forbidden;
1245 }
1246
1247 \f
1248 /************************************************************************/
1249 /*                            initialization                            */
1250 /************************************************************************/
1251
1252 void
1253 syms_of_device (void)
1254 {
1255   INIT_LRECORD_IMPLEMENTATION (device);
1256
1257   DEFSUBR (Fvalid_device_class_p);
1258   DEFSUBR (Fdevice_class_list);
1259
1260   DEFSUBR (Fdfw_device);
1261   DEFSUBR (Fselected_device);
1262   DEFSUBR (Fselect_device);
1263   DEFSUBR (Fset_device_selected_frame);
1264   DEFSUBR (Fdevicep);
1265   DEFSUBR (Fdevice_live_p);
1266   DEFSUBR (Fdevice_name);
1267   DEFSUBR (Fdevice_connection);
1268   DEFSUBR (Fdevice_console);
1269   DEFSUBR (Ffind_device);
1270   DEFSUBR (Fget_device);
1271   DEFSUBR (Fmake_device);
1272   DEFSUBR (Fdelete_device);
1273   DEFSUBR (Fdevice_frame_list);
1274   DEFSUBR (Fdevice_class);
1275   DEFSUBR (Fset_device_class);
1276   DEFSUBR (Fdevice_system_metrics);
1277   DEFSUBR (Fdevice_system_metric);
1278   DEFSUBR (Fset_device_baud_rate);
1279   DEFSUBR (Fdevice_baud_rate);
1280   DEFSUBR (Fdomain_device_type);
1281   DEFSUBR (Fdevice_printer_p);
1282
1283   defsymbol (&Qdevicep, "devicep");
1284   defsymbol (&Qdevice_live_p, "device-live-p");
1285
1286   defsymbol (&Qcreate_device_hook, "create-device-hook");
1287   defsymbol (&Qdelete_device_hook, "delete-device-hook");
1288
1289   /* Qcolor defined in general.c */
1290   defsymbol (&Qgrayscale, "grayscale");
1291   defsymbol (&Qmono, "mono");
1292
1293   /* Device metrics symbols */
1294   defsymbol (&Qcolor_default, "color-default");
1295   defsymbol (&Qcolor_select, "color-select");
1296   defsymbol (&Qcolor_balloon, "color-balloon");
1297   defsymbol (&Qcolor_3d_face, "color-3d-face");
1298   defsymbol (&Qcolor_3d_light, "color-3d-light");
1299   defsymbol (&Qcolor_3d_dark, "color-3d-dark");
1300   defsymbol (&Qcolor_menu, "color-menu");
1301   defsymbol (&Qcolor_menu_highlight, "color-menu-highlight");
1302   defsymbol (&Qcolor_menu_button, "color-menu-button");
1303   defsymbol (&Qcolor_menu_disabled, "color-menu-disabled");
1304   defsymbol (&Qcolor_toolbar, "color-toolbar");
1305   defsymbol (&Qcolor_scrollbar, "color-scrollbar");
1306   defsymbol (&Qcolor_desktop, "color-desktop");
1307   defsymbol (&Qcolor_workspace, "color-workspace");
1308   defsymbol (&Qfont_default, "font-default");
1309   defsymbol (&Qfont_menubar, "font-menubar");
1310   defsymbol (&Qfont_dialog, "font-dialog");
1311   defsymbol (&Qsize_cursor, "size-cursor");
1312   defsymbol (&Qsize_scrollbar, "size-scrollbar");
1313   defsymbol (&Qsize_menu, "size-menu");
1314   defsymbol (&Qsize_toolbar, "size-toolbar");
1315   defsymbol (&Qsize_toolbar_button, "size-toolbar-button");
1316   defsymbol (&Qsize_toolbar_border, "size-toolbar-border");
1317   defsymbol (&Qsize_icon, "size-icon");
1318   defsymbol (&Qsize_icon_small, "size-icon-small");
1319   defsymbol (&Qsize_device, "size-device");
1320   defsymbol (&Qsize_workspace, "size-workspace");
1321   defsymbol (&Qoffset_workspace, "offset-workspace");
1322   defsymbol (&Qsize_device_mm, "size-device-mm");
1323   defsymbol (&Qnum_bit_planes, "num-bit-planes");
1324   defsymbol (&Qnum_color_cells, "num-color-cells");
1325   defsymbol (&Qdevice_dpi, "device-dpi");
1326   defsymbol (&Qmouse_buttons, "mouse-buttons");
1327   defsymbol (&Qswap_buttons, "swap-buttons");
1328   defsymbol (&Qshow_sounds, "show-sounds");
1329   defsymbol (&Qslow_device, "slow-device");
1330   defsymbol (&Qsecurity, "security");
1331 }
1332
1333 void
1334 reinit_vars_of_device (void)
1335 {
1336   staticpro_nodump (&Vdefault_device);
1337   Vdefault_device = Qnil;
1338   asynch_device_change_pending = 0;
1339 }
1340
1341 void
1342 vars_of_device (void)
1343 {
1344   reinit_vars_of_device ();
1345
1346   DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /*
1347 Function or functions to call when a device is created.
1348 One argument, the newly-created device.
1349 This is called after the first frame has been created, but before
1350   calling the `create-frame-hook'.
1351 Note that in general the device will not be selected.
1352 */ );
1353   Vcreate_device_hook = Qnil;
1354
1355   DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook /*
1356 Function or functions to call when a device is deleted.
1357 One argument, the to-be-deleted device.
1358 */ );
1359   Vdelete_device_hook = Qnil;
1360
1361   Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono);
1362   staticpro (&Vdevice_class_list);
1363
1364   /* Death to devices.el !!! */
1365   Fprovide(intern("devices"));
1366 }