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
6 This file is part of XEmacs.
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
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
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. */
23 /* Synched up with: Not in FSF. */
25 /* Original version by Chuck Thompson;
26 rewritten and expanded by Ben Wing. */
39 #include "redisplay.h"
40 #include "specifier.h"
44 #ifdef HAVE_SCROLLBARS
45 #include "scrollbar.h"
48 #include "syssignal.h"
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;
56 Lisp_Object Vcreate_device_hook, Vdelete_device_hook;
59 /* Qcolor defined in general.c */
60 Lisp_Object Qgrayscale, Qmono;
62 /* Device metrics symbols */
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, Qsize_device_mm, Qdevice_dpi, Qnum_bit_planes,
72 Qnum_color_cells, Qmouse_buttons, Qswap_buttons, Qshow_sounds,
73 Qslow_device, Qsecurity;
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;
82 mark_device (Lisp_Object obj)
84 struct device *d = XDEVICE (obj);
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);
99 mark_object (d->color_instance_cache);
100 mark_object (d->font_instance_cache);
102 mark_object (d->charset_font_cache);
104 mark_object (d->image_instance_cache);
108 mark_object (d->devmeths->symbol);
109 MAYBE_DEVMETH (d, mark_device, (d));
112 return (d->frame_list);
116 print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
118 struct device *d = XDEVICE (obj);
122 error ("printing unreadable object #<device %s 0x%x>",
123 XSTRING_DATA (d->name), d->header.uid);
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))
130 write_c_string (" on ", printcharfun);
131 print_internal (DEVICE_CONNECTION (d), printcharfun, 1);
133 sprintf (buf, " 0x%x>", d->header.uid);
134 write_c_string (buf, printcharfun);
137 DEFINE_LRECORD_IMPLEMENTATION ("device", device,
138 mark_device, print_device, 0, 0, 0, 0,
142 valid_device_class_p (Lisp_Object class)
144 return !NILP (memq_no_quit (class, Vdevice_class_list));
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.
153 return valid_device_class_p (device_class) ? Qt : Qnil;
156 DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /*
157 Return a list of valid device classes.
161 return Fcopy_sequence (Vdevice_class_list);
164 static struct device *
165 allocate_device (Lisp_Object console)
168 struct device *d = alloc_lcrecord_type (struct device, &lrecord_device);
173 XSETDEVICE (device, d);
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;
190 d->infd = d->outfd = -1;
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);
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);
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.
207 d->image_instance_cache =
208 make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
215 decode_device (Lisp_Object 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);
226 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /*
227 Given a device, frame, or window, return the associated device.
228 Return nil otherwise.
232 return DFW_DEVICE (obj);
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.
243 if (NILP (console) && NILP (Vselected_console))
244 return Qnil; /* happens early in temacs */
245 return CONSOLE_SELECTED_DEVICE (decode_console (console));
248 /* Called from selected_frame_1(), called from Fselect_window() */
250 select_device_1 (Lisp_Object device)
252 struct device *dev = XDEVICE (device);
253 Lisp_Object old_selected_device = Fselected_device (Qnil);
255 if (EQ (device, old_selected_device))
258 /* now select the device's console */
259 CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (dev))) = device;
260 select_console_1 (DEVICE_CONSOLE (dev));
263 DEFUN ("select-device", Fselect_device, 1, 1, 0, /*
264 Select the device DEVICE.
265 Subsequent editing commands apply to its console, selected frame,
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
273 CHECK_LIVE_DEVICE (device);
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)))),
282 error ("Can't select a device with no frames");
287 set_device_selected_frame (struct device *d, Lisp_Object frame)
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;
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.
301 XSETDEVICE (device, decode_device (device));
302 CHECK_LIVE_FRAME (frame);
304 if (! EQ (device, FRAME_DEVICE (XFRAME (frame))))
305 error ("In `set-device-selected-frame', FRAME is not on DEVICE");
307 if (EQ (device, Fselected_device (Qnil)))
308 return Fselect_frame (frame);
310 set_device_selected_frame (XDEVICE (device), frame);
314 DEFUN ("devicep", Fdevicep, 1, 1, 0, /*
315 Return non-nil if OBJECT is a device.
319 return DEVICEP (object) ? Qt : Qnil;
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.
327 return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil;
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.
336 return DEVICE_NAME (decode_device (device));
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.
345 return DEVICE_CONNECTION (decode_device (device));
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.
354 return DEVICE_CONSOLE (decode_device (device));
357 #ifdef HAVE_WINDOW_SYSTEM
360 init_global_resources (struct device *d)
362 init_global_faces (d);
363 #ifdef HAVE_SCROLLBARS
364 init_global_scrollbars (d);
367 init_global_toolbars (d);
374 init_device_resources (struct device *d)
376 init_device_faces (d);
377 #ifdef HAVE_SCROLLBARS
378 init_device_scrollbars (d);
381 init_device_toolbars (d);
386 semi_canonicalize_device_connection (struct console_methods *meths,
387 Lisp_Object name, Error_behavior errb)
389 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection,
394 canonicalize_device_connection (struct console_methods *meths,
395 Lisp_Object name, Error_behavior errb)
397 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection,
402 find_device_of_type (struct console_methods *meths, Lisp_Object canon)
404 Lisp_Object devcons, concons;
406 DEVICE_LOOP_NO_BREAK (devcons, concons)
408 Lisp_Object device = XCAR (devcons);
410 if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device)))
411 && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)),
419 DEFUN ("find-device", Ffind_device, 1, 2, 0, /*
420 Look for an existing device attached to connection CONNECTION.
421 Return the device if found; otherwise, return nil.
423 If TYPE is specified, only return devices of that type; otherwise,
424 return devices of any type. (It is possible, although unlikely,
425 that two devices of different types could have the same connection
426 name; in such a case, the first device found is returned.)
430 Lisp_Object canon = Qnil;
437 struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
438 canon = canonicalize_device_connection (conmeths, connection,
440 if (UNBOUNDP (canon))
441 RETURN_UNGCPRO (Qnil);
443 RETURN_UNGCPRO (find_device_of_type (conmeths, canon));
449 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
451 struct console_methods *conmeths =
452 Dynarr_at (the_console_type_entry_dynarr, i).meths;
453 canon = canonicalize_device_connection (conmeths, connection,
455 if (!UNBOUNDP (canon))
457 Lisp_Object device = find_device_of_type (conmeths, canon);
459 RETURN_UNGCPRO (device);
463 RETURN_UNGCPRO (Qnil);
467 DEFUN ("get-device", Fget_device, 1, 2, 0, /*
468 Look for an existing device attached to connection CONNECTION.
469 Return the device if found; otherwise, signal an error.
471 If TYPE is specified, only return devices of that type; otherwise,
472 return devices of any type. (It is possible, although unlikely,
473 that two devices of different types could have the same connection
474 name; in such a case, the first device found is returned.)
478 Lisp_Object device = Ffind_device (connection, type);
482 signal_simple_error ("No such device", connection);
484 signal_simple_error_2 ("No such device", type, connection);
490 delete_deviceless_console (Lisp_Object console)
492 if (NILP (XCONSOLE (console)->device_list))
493 Fdelete_console (console, Qnil);
497 DEFUN ("make-device", Fmake_device, 2, 3, 0, /*
498 Return a new device of type TYPE, attached to connection CONNECTION.
500 The valid values for CONNECTION are device-specific; however,
501 CONNECTION is generally a string. (Specifically, for X devices,
502 CONNECTION should be a display specification such as "foo:0", and
503 for TTY devices, CONNECTION should be the filename of a TTY device
504 file, such as "/dev/ttyp4", or nil to refer to XEmacs' standard
507 PROPS, if specified, should be a plist of properties controlling
510 If CONNECTION specifies an already-existing device connection, that
511 device is simply returned; no new device is created, and PROPS
514 (type, connection, props))
516 /* This function can GC */
519 Lisp_Object device = Qnil;
520 Lisp_Object console = Qnil;
521 Lisp_Object name = Qnil;
522 struct console_methods *conmeths;
523 int speccount = specpdl_depth();
525 struct gcpro gcpro1, gcpro2, gcpro3;
526 #ifdef HAVE_X_WINDOWS
527 /* #### icky-poo. If this is the first X device we are creating,
528 then retrieve the global face resources. We have to do it
529 here, at the same time as (or just before) the device face
530 resources are retrieved; specifically, it needs to be done
531 after the device has been created but before any frames have
532 been popped up or much anything else has been done. It's
533 possible for other devices to specify different global
534 resources (there's a property on each X server's root window
535 that holds some resources); tough luck for the moment.
537 This is a nasty violation of device independence, but
538 there's not a whole lot I can figure out to do about it.
539 The real problem is that the concept of resources is not
540 generalized away from X. Similar resource-related
541 device-independence violations occur in faces.el. */
542 int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx);
545 GCPRO3 (device, console, name);
547 conmeths = decode_console_type (type, ERROR_ME_NOT);
549 signal_simple_error ("Invalid device type", type);
551 device = Ffind_device (connection, type);
553 RETURN_UNGCPRO (device);
555 name = Fplist_get (props, Qname, Qnil);
558 Lisp_Object conconnect =
559 (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ?
560 CONTYPE_METH (conmeths, device_to_console_connection,
561 (connection, ERROR_ME)) :
563 console = create_console (name, type, conconnect, props);
566 record_unwind_protect(delete_deviceless_console, console);
568 con = XCONSOLE (console);
569 d = allocate_device (console);
570 XSETDEVICE (device, d);
572 d->devmeths = con->conmeths;
574 DEVICE_NAME (d) = name;
575 DEVICE_CONNECTION (d) =
576 semi_canonicalize_device_connection (conmeths, connection, ERROR_ME);
577 DEVICE_CANON_CONNECTION (d) =
578 canonicalize_device_connection (conmeths, connection, ERROR_ME);
580 MAYBE_DEVMETH (d, init_device, (d, props));
582 /* Do it this way so that the device list is in order of creation */
583 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil));
584 RESET_CHANGED_SET_FLAGS;
585 if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device)))
586 Vdefault_device = device;
588 init_device_sound (d);
589 #ifdef HAVE_X_WINDOWS
591 init_global_resources (d);
593 init_device_resources (d);
595 MAYBE_DEVMETH (d, finish_init_device, (d, props));
597 /* If this is the first device on the console, make it the selected one. */
598 if (NILP (CONSOLE_SELECTED_DEVICE (con)))
599 CONSOLE_SELECTED_DEVICE (con) = device;
601 /* #### the following should trap errors. */
602 setup_device_initial_specifier_tags (d);
605 unbind_to(speccount, Qnil);
609 /* find a device other than the selected one. Prefer non-stream
610 devices over stream devices. Maybe stay on the same console. */
613 find_other_device (Lisp_Object device, int on_same_console)
615 Lisp_Object devcons = Qnil, concons;
616 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device));
618 /* look for a non-stream device */
619 DEVICE_LOOP_NO_BREAK (devcons, concons)
621 Lisp_Object dev = XCAR (devcons);
622 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
624 if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) &&
625 !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
631 return XCAR (devcons);
633 /* OK, now look for a stream device */
634 DEVICE_LOOP_NO_BREAK (devcons, concons)
636 Lisp_Object dev = XCAR (devcons);
637 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
639 if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
644 return XCAR (devcons);
646 /* Sorry, there ain't none */
651 find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame,
656 VOID_TO_LISP (device, closure);
657 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
659 if (EQ (device, FRAME_DEVICE (XFRAME (frame))))
665 find_nonminibuffer_frame_not_on_device (Lisp_Object device)
667 return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate,
668 LISP_TO_VOID (device));
674 If FORCE is non-zero, allow deletion of the only frame.
676 If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if
677 deleting the last device on a console, just delete it,
678 instead of calling `delete-console'.
680 If FROM_IO_ERROR is non-zero, then the device is gone due
681 to an I/O error. This affects what happens if we exit
682 (we do an emergency exit instead of `save-buffers-kill-emacs'.)
686 delete_device_internal (struct device *d, int force,
687 int called_from_delete_console,
690 /* This function can GC */
695 /* OK to delete an already-deleted device. */
696 if (!DEVICE_LIVE_P (d))
699 XSETDEVICE (device, d);
702 c = XCONSOLE (DEVICE_CONSOLE (d));
704 if (!called_from_delete_console)
706 int delete_console = 0;
707 /* If we're deleting the only device on the console,
708 delete the console. */
709 if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1)
710 /* if we just created the device, it might not be listed,
712 && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c))))
714 /* Or if there aren't any nonminibuffer frames that would be
715 left, delete the console (this will make XEmacs exit). */
716 else if (NILP (find_nonminibuffer_frame_not_on_device (device)))
721 delete_console_internal (c, force, 0, from_io_error);
727 reset_one_device (d);
732 /* First delete all frames without their own minibuffers,
733 to avoid errors coming from attempting to delete a frame
734 that is a surrogate for another frame. */
735 DEVICE_FRAME_LOOP (frmcons, d)
737 struct frame *f = XFRAME (XCAR (frmcons));
738 /* delete_frame_internal() might do anything such as run hooks,
740 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
741 delete_frame_internal (f, 1, 1, from_io_error);
743 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
744 go ahead and delete anything */
751 /* #### This should probably be a device method but it is time for
752 19.14 to go out the door. */
753 #ifdef HAVE_X_WINDOWS
754 /* Next delete all frames which have the popup property to avoid
755 deleting a child after its parent. */
756 DEVICE_FRAME_LOOP (frmcons, d)
758 struct frame *f = XFRAME (XCAR (frmcons));
760 if (FRAME_LIVE_P (f))
762 Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil);
764 delete_frame_internal (f, 1, 1, from_io_error);
766 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
767 go ahead and delete anything */
774 #endif /* HAVE_X_WINDOWS */
776 DEVICE_FRAME_LOOP (frmcons, d)
778 struct frame *f = XFRAME (XCAR (frmcons));
779 /* delete_frame_internal() might do anything such as run hooks,
781 if (FRAME_LIVE_P (f))
782 delete_frame_internal (f, 1, 1, from_io_error);
784 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
785 go ahead and delete anything */
793 set_device_selected_frame (d, Qnil);
795 /* try to select another device */
797 if (EQ (device, Fselected_device (DEVICE_CONSOLE (d))))
799 Lisp_Object other_dev = find_other_device (device, 1);
800 if (!NILP (other_dev))
801 Fselect_device (other_dev);
804 if (EQ (device, Vdefault_device))
805 Vdefault_device = find_other_device (device, 0);
807 MAYBE_DEVMETH (d, delete_device, (d));
809 CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c));
810 RESET_CHANGED_SET_FLAGS;
811 d->devmeths = dead_console_methods;
815 /* delete a device as a result of an I/O error. Called from
816 an enqueued magic-eval event. */
819 io_error_delete_device (Lisp_Object device)
821 /* Note: it's the console that should get deleted, but
822 delete_device_internal() contains a hack that also deletes the
823 console when called from this function. */
824 delete_device_internal (XDEVICE (device), 1, 0, 1);
827 DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /*
828 Delete DEVICE, permanently eliminating it from use.
829 Normally, you cannot delete the last non-minibuffer-only frame (you must
830 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
831 second argument FORCE is non-nil, you can delete the last frame. (This
832 will automatically call `save-buffers-kill-emacs'.)
836 CHECK_DEVICE (device);
837 delete_device_internal (XDEVICE (device), !NILP (force), 0, 0);
841 DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /*
842 Return a list of all frames on DEVICE.
843 If DEVICE is nil, the selected device will be used.
847 return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device)));
850 DEFUN ("device-class", Fdevice_class, 0, 1, 0, /*
851 Return the class (color behavior) of DEVICE.
852 This will be one of 'color, 'grayscale, or 'mono.
856 return DEVICE_CLASS (decode_device (device));
859 DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /*
860 Set the class (color behavior) of DEVICE.
861 CLASS should be one of 'color, 'grayscale, or 'mono.
862 This is only allowed on device such as TTY devices, where the color
863 behavior cannot necessarily be determined automatically.
867 struct device *d = decode_device (device);
868 XSETDEVICE (device, d);
869 if (!DEVICE_TTY_P (d))
870 signal_simple_error ("Cannot change the class of this device", device);
871 if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale))
872 signal_simple_error ("Must be color, mono, or grayscale", class);
873 if (! EQ (DEVICE_CLASS (d), class))
876 DEVICE_CLASS (d) = class;
877 DEVICE_FRAME_LOOP (frmcons, d)
879 struct frame *f = XFRAME (XCAR (frmcons));
881 recompute_all_cached_specifiers_in_frame (f);
882 MARK_FRAME_FACES_CHANGED (f);
883 MARK_FRAME_GLYPHS_CHANGED (f);
884 MARK_FRAME_SUBWINDOWS_CHANGED (f);
885 MARK_FRAME_TOOLBARS_CHANGED (f);
886 f->menubar_changed = 1;
892 DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /*
893 Set the output baud rate of DEVICE to RATE.
894 On most systems, changing this value will affect the amount of padding
895 and other strategic decisions made during redisplay.
901 DEVICE_BAUD_RATE (decode_device (device)) = XINT (rate);
906 DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /*
907 Return the output baud rate of DEVICE.
911 return make_int (DEVICE_BAUD_RATE (decode_device (device)));
914 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
915 Get a metric for DEVICE as provided by the system.
917 METRIC must be a symbol specifying requested metric. Note that the metrics
918 returned are these provided by the system internally, not read from resources,
919 so obtained from the most internal level.
921 If a metric is not provided by the system, then DEFAULT is returned.
923 When DEVICE is nil, selected device is assumed
925 Metrics, by group, are:
927 COLORS. Colors are returned as valid color instantiators. No other assumption
928 on the returned value should be made (i.e. it can be a string on one system but
929 a color instance on another). For colors, returned value is a cons of
930 foreground and background colors. Note that if the system provides only one
931 color of the pair, the second one may be nil.
933 color-default Standard window text foreground and background.
934 color-select Selection highlight text and background colors.
935 color-balloon Balloon popup text and background colors.
936 color-3d-face 3-D object (button, modeline) text and surface colors.
937 color-3d-light Fore and back colors for 3-D edges facing light source.
938 color-3d-dark Fore and back colors for 3-D edges facing away from
940 color-menu Text and background for menus
941 color-menu-highlight Selected menu item colors
942 color-menu-button Menu button colors
943 color-menu-disabled Unselectable menu item colors
944 color-toolbar Toolbar foreground and background colors
945 color-scrollbar Scrollbar foreground and background colors
946 color-desktop Desktop window colors
947 color-workspace Workspace window colors
949 FONTS. Fonts are returned as valid font instantiators. No other assumption on
950 the returned value should be made (i.e. it can be a string on one system but
951 font instance on another).
953 font-default Default fixed width font.
954 font-menubar Menubar font
955 font-dialog Dialog boxes font
957 GEOMETRY. These metrics are returned as conses of (X . Y). As with colors,
958 either car or cdr of the cons may be nil if the system does not provide one
959 of the corresponding dimensions.
961 size-cursor Mouse cursor size.
962 size-scrollbar Scrollbars (WIDTH . HEIGHT)
963 size-menu Menubar height, as (nil . HEIGHT)
964 size-toolbar Toolbar width and height.
965 size-toolbar-button Toolbar button size.
966 size-toolbar-border Toolbar border width and height.
967 size-icon Icon dimensions.
968 size-icon-small Small icon dimensions.
969 size-device Device screen size in pixels.
970 size-workspace Workspace size in pixels. This can be less than the
971 above if window manager has decorations which
972 effectively shrink the area remaining for application
974 size-device-mm Device screen size in millimeters.
975 device-dpi Device resolution, in dots per inch.
976 num-bit-planes Integer, number of device bit planes.
977 num-color-cells Integer, number of device color cells.
979 FEATURES. This group reports various device features. If a feature is
980 present, integer 1 (one) is returned, if it is not present, then integer
981 0 (zero) is returned. If the system is unaware of the feature, then
984 mouse-buttons Integer, number of mouse buttons, or zero if no mouse.
985 swap-buttons Non-zero if left and right mouse buttons are swapped.
986 show-sounds User preference for visual over audible bell.
987 slow-device Device is slow, avoid animation.
988 security Non-zero if user environment is secure.
990 (device, metric, default_))
992 struct device *d = decode_device (device);
993 enum device_metrics m;
998 else if (EQ (metric, Q##met)) \
1003 FROB (color_default);
1004 FROB (color_select);
1005 FROB (color_balloon);
1006 FROB (color_3d_face);
1007 FROB (color_3d_light);
1008 FROB (color_3d_dark);
1010 FROB (color_menu_highlight);
1011 FROB (color_menu_button);
1012 FROB (color_menu_disabled);
1013 FROB (color_toolbar);
1014 FROB (color_scrollbar);
1015 FROB (color_desktop);
1016 FROB (color_workspace);
1017 FROB (font_default);
1018 FROB (font_menubar);
1021 FROB (size_scrollbar);
1023 FROB (size_toolbar);
1024 FROB (size_toolbar_button);
1025 FROB (size_toolbar_border);
1027 FROB (size_icon_small);
1029 FROB (size_workspace);
1030 FROB (size_device_mm);
1032 FROB (num_bit_planes);
1033 FROB (num_color_cells);
1034 FROB (mouse_buttons);
1035 FROB (swap_buttons);
1040 signal_simple_error ("Invalid device metric symbol", metric);
1042 res = DEVMETH_OR_GIVEN (d, device_system_metrics, (d, m), Qunbound);
1043 return UNBOUNDP(res) ? default_ : res;
1048 DEFUN ("device-system-metrics", Fdevice_system_metrics, 0, 1, 0, /*
1049 Get a property list of device metric for DEVICE.
1051 See `device-system-metric' for the description of available metrics.
1052 DEVICE defaults to selected device when omitted.
1056 struct device *d = decode_device (device);
1057 Lisp_Object plist = Qnil, one_metric;
1060 if (!UNBOUNDP ((one_metric = \
1061 DEVMETH_OR_GIVEN (d, device_system_metrics, \
1062 (d, DM_##m), Qunbound)))) \
1063 plist = Fcons (Q##m, Fcons (one_metric, plist));
1065 FROB (color_default);
1066 FROB (color_select);
1067 FROB (color_balloon);
1068 FROB (color_3d_face);
1069 FROB (color_3d_light);
1070 FROB (color_3d_dark);
1072 FROB (color_menu_highlight);
1073 FROB (color_menu_button);
1074 FROB (color_menu_disabled);
1075 FROB (color_toolbar);
1076 FROB (color_scrollbar);
1077 FROB (color_desktop);
1078 FROB (color_workspace);
1079 FROB (font_default);
1080 FROB (font_menubar);
1083 FROB (size_scrollbar);
1085 FROB (size_toolbar);
1086 FROB (size_toolbar_button);
1087 FROB (size_toolbar_border);
1089 FROB (size_icon_small);
1091 FROB (size_workspace);
1092 FROB (size_device_mm);
1094 FROB (num_bit_planes);
1095 FROB (num_color_cells);
1096 FROB (mouse_buttons);
1097 FROB (swap_buttons);
1108 domain_device_type (Lisp_Object domain)
1110 /* This cannot GC */
1111 assert (WINDOWP (domain) || FRAMEP (domain)
1112 || DEVICEP (domain) || CONSOLEP (domain));
1114 if (WINDOWP (domain))
1116 if (!WINDOW_LIVE_P (XWINDOW (domain)))
1118 domain = WINDOW_FRAME (XWINDOW (domain));
1120 if (FRAMEP (domain))
1122 if (!FRAME_LIVE_P (XFRAME (domain)))
1124 domain = FRAME_DEVICE (XFRAME (domain));
1126 if (DEVICEP (domain))
1128 if (!DEVICE_LIVE_P (XDEVICE (domain)))
1130 domain = DEVICE_CONSOLE (XDEVICE (domain));
1132 return CONSOLE_TYPE (XCONSOLE (domain));
1136 * Determine whether window system bases window geometry on character
1138 * Return non-zero for pixel-based geometry, zero for character-based.
1141 window_system_pixelated_geometry (Lisp_Object domain)
1143 /* This cannot GC */
1144 Lisp_Object winsy = domain_device_type (domain);
1145 struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT);
1147 return (MAYBE_INT_CONTYPE_METH (meth, device_implementation_flags, ())
1148 & XDEVIMPF_PIXEL_GEOMETRY);
1151 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /*
1152 Return the device type symbol for a DOMAIN, e.g. 'x or 'tty.
1153 DOMAIN can be either a window, frame, device or console.
1157 if (!WINDOWP (domain) && !FRAMEP (domain)
1158 && !DEVICEP (domain) && !CONSOLEP (domain))
1160 ("Domain must be either a window, frame, device or console", domain);
1162 return domain_device_type (domain);
1166 handle_asynch_device_change (void)
1169 int old_asynch_device_change_pending = asynch_device_change_pending;
1170 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
1172 if (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1173 asynch_device_change_method)
1174 (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1175 asynch_device_change_method) ();
1177 /* reset the flag to 0 unless another notification occurred while
1178 we were processing this one. Block SIGWINCH during this
1179 check to prevent a possible race condition. */
1181 EMACS_BLOCK_SIGNAL (SIGWINCH);
1183 if (old_asynch_device_change_pending == asynch_device_change_pending)
1184 asynch_device_change_pending = 0;
1186 EMACS_UNBLOCK_SIGNAL (SIGWINCH);
1191 call_critical_lisp_code (struct device *d, Lisp_Object function,
1194 int old_gc_currently_forbidden = gc_currently_forbidden;
1195 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1197 /* There's no reason to bother doing specbinds here, because if
1198 initialize-*-faces signals an error, emacs is going to crash
1201 gc_currently_forbidden = 1;
1205 /* But it's useful to have an error handler; otherwise an infinite
1208 call1_with_handler (Qreally_early_error_handler, function, object);
1210 call0_with_handler (Qreally_early_error_handler, function);
1213 Vinhibit_quit = old_inhibit_quit;
1214 gc_currently_forbidden = old_gc_currently_forbidden;
1218 /************************************************************************/
1219 /* initialization */
1220 /************************************************************************/
1223 syms_of_device (void)
1225 DEFSUBR (Fvalid_device_class_p);
1226 DEFSUBR (Fdevice_class_list);
1228 DEFSUBR (Fdfw_device);
1229 DEFSUBR (Fselected_device);
1230 DEFSUBR (Fselect_device);
1231 DEFSUBR (Fset_device_selected_frame);
1233 DEFSUBR (Fdevice_live_p);
1234 DEFSUBR (Fdevice_name);
1235 DEFSUBR (Fdevice_connection);
1236 DEFSUBR (Fdevice_console);
1237 DEFSUBR (Ffind_device);
1238 DEFSUBR (Fget_device);
1239 DEFSUBR (Fmake_device);
1240 DEFSUBR (Fdelete_device);
1241 DEFSUBR (Fdevice_frame_list);
1242 DEFSUBR (Fdevice_class);
1243 DEFSUBR (Fset_device_class);
1244 DEFSUBR (Fdevice_system_metrics);
1245 DEFSUBR (Fdevice_system_metric);
1246 DEFSUBR (Fset_device_baud_rate);
1247 DEFSUBR (Fdevice_baud_rate);
1248 DEFSUBR (Fdomain_device_type);
1250 defsymbol (&Qdevicep, "devicep");
1251 defsymbol (&Qdevice_live_p, "device-live-p");
1253 defsymbol (&Qcreate_device_hook, "create-device-hook");
1254 defsymbol (&Qdelete_device_hook, "delete-device-hook");
1256 /* Qcolor defined in general.c */
1257 defsymbol (&Qgrayscale, "grayscale");
1258 defsymbol (&Qmono, "mono");
1260 /* Device metrics symbols */
1261 defsymbol (&Qcolor_default, "color-default");
1262 defsymbol (&Qcolor_select, "color-select");
1263 defsymbol (&Qcolor_balloon, "color-balloon");
1264 defsymbol (&Qcolor_3d_face, "color-3d-face");
1265 defsymbol (&Qcolor_3d_light, "color-3d-light");
1266 defsymbol (&Qcolor_3d_dark, "color-3d-dark");
1267 defsymbol (&Qcolor_menu, "color-menu");
1268 defsymbol (&Qcolor_menu_highlight, "color-menu-highlight");
1269 defsymbol (&Qcolor_menu_button, "color-menu-button");
1270 defsymbol (&Qcolor_menu_disabled, "color-menu-disabled");
1271 defsymbol (&Qcolor_toolbar, "color-toolbar");
1272 defsymbol (&Qcolor_scrollbar, "color-scrollbar");
1273 defsymbol (&Qcolor_desktop, "color-desktop");
1274 defsymbol (&Qcolor_workspace, "color-workspace");
1275 defsymbol (&Qfont_default, "font-default");
1276 defsymbol (&Qfont_menubar, "font-menubar");
1277 defsymbol (&Qfont_dialog, "font-dialog");
1278 defsymbol (&Qsize_cursor, "size-cursor");
1279 defsymbol (&Qsize_scrollbar, "size-scrollbar");
1280 defsymbol (&Qsize_menu, "size-menu");
1281 defsymbol (&Qsize_toolbar, "size-toolbar");
1282 defsymbol (&Qsize_toolbar_button, "size-toolbar-button");
1283 defsymbol (&Qsize_toolbar_border, "size-toolbar-border");
1284 defsymbol (&Qsize_icon, "size-icon");
1285 defsymbol (&Qsize_icon_small, "size-icon-small");
1286 defsymbol (&Qsize_device, "size-device");
1287 defsymbol (&Qsize_workspace, "size-workspace");
1288 defsymbol (&Qsize_device_mm, "size-device-mm");
1289 defsymbol (&Qnum_bit_planes, "num-bit-planes");
1290 defsymbol (&Qnum_color_cells, "num-color-cells");
1291 defsymbol (&Qdevice_dpi, "device-dpi");
1292 defsymbol (&Qmouse_buttons, "mouse-buttons");
1293 defsymbol (&Qswap_buttons, "swap-buttons");
1294 defsymbol (&Qshow_sounds, "show-sounds");
1295 defsymbol (&Qslow_device, "slow-device");
1296 defsymbol (&Qsecurity, "security");
1300 reinit_vars_of_device (void)
1302 staticpro_nodump (&Vdefault_device);
1303 Vdefault_device = Qnil;
1304 asynch_device_change_pending = 0;
1308 vars_of_device (void)
1310 reinit_vars_of_device ();
1312 DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /*
1313 Function or functions to call when a device is created.
1314 One argument, the newly-created device.
1315 This is called after the first frame has been created, but before
1316 calling the `create-frame-hook'.
1317 Note that in general the device will not be selected.
1319 Vcreate_device_hook = Qnil;
1321 DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook /*
1322 Function or functions to call when a device is deleted.
1323 One argument, the to-be-deleted device.
1325 Vdelete_device_hook = Qnil;
1327 Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono);
1328 staticpro (&Vdevice_class_list);
1330 /* Death to devices.el !!! */
1331 Fprovide(intern("devices"));