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