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, Qoffset_workspace, Qsize_device_mm, Qdevice_dpi,
72 Qnum_bit_planes, Qnum_color_cells, Qmouse_buttons, Qswap_buttons,
73 Qshow_sounds, 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) && !NILP (DEVICE_CONNECTION (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 if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_device_connection))
390 return CONTYPE_METH (meths, semi_canonicalize_device_connection,
393 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection,
398 canonicalize_device_connection (struct console_methods *meths,
399 Lisp_Object name, Error_behavior errb)
401 if (HAS_CONTYPE_METH_P (meths, canonicalize_device_connection))
402 return CONTYPE_METH (meths, canonicalize_device_connection,
405 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection,
410 find_device_of_type (struct console_methods *meths, Lisp_Object canon)
412 Lisp_Object devcons, concons;
414 DEVICE_LOOP_NO_BREAK (devcons, concons)
416 Lisp_Object device = XCAR (devcons);
418 if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device)))
419 && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)),
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.
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.)
438 Lisp_Object canon = Qnil;
445 struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
446 canon = canonicalize_device_connection (conmeths, connection,
448 if (UNBOUNDP (canon))
449 RETURN_UNGCPRO (Qnil);
451 RETURN_UNGCPRO (find_device_of_type (conmeths, canon));
457 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
459 struct console_methods *conmeths =
460 Dynarr_at (the_console_type_entry_dynarr, i).meths;
461 canon = canonicalize_device_connection (conmeths, connection,
463 if (!UNBOUNDP (canon))
465 Lisp_Object device = find_device_of_type (conmeths, canon);
467 RETURN_UNGCPRO (device);
471 RETURN_UNGCPRO (Qnil);
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.
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.)
486 Lisp_Object device = Ffind_device (connection, type);
490 signal_simple_error ("No such device", connection);
492 signal_simple_error_2 ("No such device", type, connection);
498 delete_deviceless_console (Lisp_Object console)
500 if (NILP (XCONSOLE (console)->device_list))
501 Fdelete_console (console, Qnil);
505 DEFUN ("make-device", Fmake_device, 2, 3, 0, /*
506 Return a new device of type TYPE, attached to connection CONNECTION.
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
515 PROPS, if specified, should be a plist of properties controlling
518 If CONNECTION specifies an already-existing device connection, that
519 device is simply returned; no new device is created, and PROPS
522 (type, connection, props))
524 /* This function can GC */
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();
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.
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);
553 GCPRO3 (device, console, name);
555 conmeths = decode_console_type (type, ERROR_ME_NOT);
557 signal_simple_error ("Invalid device type", type);
559 device = Ffind_device (connection, type);
561 RETURN_UNGCPRO (device);
563 name = Fplist_get (props, Qname, Qnil);
566 Lisp_Object conconnect =
567 (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ?
568 CONTYPE_METH (conmeths, device_to_console_connection,
569 (connection, ERROR_ME)) :
571 console = create_console (name, type, conconnect, props);
574 record_unwind_protect(delete_deviceless_console, console);
576 con = XCONSOLE (console);
577 d = allocate_device (console);
578 XSETDEVICE (device, d);
580 d->devmeths = con->conmeths;
582 DEVICE_NAME (d) = name;
583 DEVICE_CONNECTION (d) =
584 semi_canonicalize_device_connection (conmeths, connection, ERROR_ME);
585 DEVICE_CANON_CONNECTION (d) =
586 canonicalize_device_connection (conmeths, connection, ERROR_ME);
588 MAYBE_DEVMETH (d, init_device, (d, props));
590 /* Do it this way so that the device list is in order of creation */
591 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil));
592 RESET_CHANGED_SET_FLAGS;
593 if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device)))
594 Vdefault_device = device;
596 init_device_sound (d);
597 #ifdef HAVE_X_WINDOWS
599 init_global_resources (d);
601 init_device_resources (d);
603 MAYBE_DEVMETH (d, finish_init_device, (d, props));
605 /* If this is the first device on the console, make it the selected one. */
606 if (NILP (CONSOLE_SELECTED_DEVICE (con)))
607 CONSOLE_SELECTED_DEVICE (con) = device;
609 /* #### the following should trap errors. */
610 setup_device_initial_specifier_tags (d);
613 unbind_to(speccount, Qnil);
617 /* find a device other than the selected one. Prefer non-stream
618 devices over stream devices. Maybe stay on the same console. */
621 find_other_device (Lisp_Object device, int on_same_console)
623 Lisp_Object devcons = Qnil, concons;
624 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device));
626 /* look for a non-stream device */
627 DEVICE_LOOP_NO_BREAK (devcons, concons)
629 Lisp_Object dev = XCAR (devcons);
630 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
632 if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) &&
633 !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
639 return XCAR (devcons);
641 /* OK, now look for a stream device */
642 DEVICE_LOOP_NO_BREAK (devcons, concons)
644 Lisp_Object dev = XCAR (devcons);
645 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
647 if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
652 return XCAR (devcons);
654 /* Sorry, there ain't none */
659 find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame,
664 VOID_TO_LISP (device, closure);
665 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
667 if (EQ (device, FRAME_DEVICE (XFRAME (frame))))
673 find_nonminibuffer_frame_not_on_device (Lisp_Object device)
675 return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate,
676 LISP_TO_VOID (device));
682 If FORCE is non-zero, allow deletion of the only frame.
684 If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if
685 deleting the last device on a console, just delete it,
686 instead of calling `delete-console'.
688 If FROM_IO_ERROR is non-zero, then the device is gone due
689 to an I/O error. This affects what happens if we exit
690 (we do an emergency exit instead of `save-buffers-kill-emacs'.)
694 delete_device_internal (struct device *d, int force,
695 int called_from_delete_console,
698 /* This function can GC */
703 /* OK to delete an already-deleted device. */
704 if (!DEVICE_LIVE_P (d))
707 XSETDEVICE (device, d);
710 c = XCONSOLE (DEVICE_CONSOLE (d));
712 if (!called_from_delete_console)
714 int delete_console = 0;
715 /* If we're deleting the only device on the console,
716 delete the console. */
717 if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1)
718 /* if we just created the device, it might not be listed,
720 && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c))))
722 /* Or if there aren't any nonminibuffer frames that would be
723 left, delete the console (this will make XEmacs exit). */
724 else if (NILP (find_nonminibuffer_frame_not_on_device (device)))
729 delete_console_internal (c, force, 0, from_io_error);
735 reset_one_device (d);
740 /* First delete all frames without their own minibuffers,
741 to avoid errors coming from attempting to delete a frame
742 that is a surrogate for another frame. */
743 DEVICE_FRAME_LOOP (frmcons, d)
745 struct frame *f = XFRAME (XCAR (frmcons));
746 /* delete_frame_internal() might do anything such as run hooks,
748 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
749 delete_frame_internal (f, 1, 1, from_io_error);
751 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
752 go ahead and delete anything */
759 /* #### This should probably be a device method but it is time for
760 19.14 to go out the door. */
761 #ifdef HAVE_X_WINDOWS
762 /* Next delete all frames which have the popup property to avoid
763 deleting a child after its parent. */
764 DEVICE_FRAME_LOOP (frmcons, d)
766 struct frame *f = XFRAME (XCAR (frmcons));
768 if (FRAME_LIVE_P (f))
770 Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil);
772 delete_frame_internal (f, 1, 1, from_io_error);
774 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
775 go ahead and delete anything */
782 #endif /* HAVE_X_WINDOWS */
784 DEVICE_FRAME_LOOP (frmcons, d)
786 struct frame *f = XFRAME (XCAR (frmcons));
787 /* delete_frame_internal() might do anything such as run hooks,
789 if (FRAME_LIVE_P (f))
790 delete_frame_internal (f, 1, 1, from_io_error);
792 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
793 go ahead and delete anything */
801 set_device_selected_frame (d, Qnil);
803 /* try to select another device */
805 if (EQ (device, Fselected_device (DEVICE_CONSOLE (d))))
807 Lisp_Object other_dev = find_other_device (device, 1);
808 if (!NILP (other_dev))
809 Fselect_device (other_dev);
812 if (EQ (device, Vdefault_device))
813 Vdefault_device = find_other_device (device, 0);
815 MAYBE_DEVMETH (d, delete_device, (d));
817 CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c));
818 RESET_CHANGED_SET_FLAGS;
819 d->devmeths = dead_console_methods;
823 /* delete a device as a result of an I/O error. Called from
824 an enqueued magic-eval event. */
827 io_error_delete_device (Lisp_Object device)
829 /* Note: it's the console that should get deleted, but
830 delete_device_internal() contains a hack that also deletes the
831 console when called from this function. */
832 delete_device_internal (XDEVICE (device), 1, 0, 1);
835 DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /*
836 Delete DEVICE, permanently eliminating it from use.
837 Normally, you cannot delete the last non-minibuffer-only frame (you must
838 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
839 second argument FORCE is non-nil, you can delete the last frame. (This
840 will automatically call `save-buffers-kill-emacs'.)
844 CHECK_DEVICE (device);
845 delete_device_internal (XDEVICE (device), !NILP (force), 0, 0);
849 DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /*
850 Return a list of all frames on DEVICE.
851 If DEVICE is nil, the selected device will be used.
855 return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device)));
858 DEFUN ("device-class", Fdevice_class, 0, 1, 0, /*
859 Return the class (color behavior) of DEVICE.
860 This will be one of 'color, 'grayscale, or 'mono.
864 return DEVICE_CLASS (decode_device (device));
867 DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /*
868 Set the class (color behavior) of DEVICE.
869 CLASS should be one of 'color, 'grayscale, or 'mono.
870 This is only allowed on device such as TTY devices, where the color
871 behavior cannot necessarily be determined automatically.
875 struct device *d = decode_device (device);
876 XSETDEVICE (device, d);
877 if (!DEVICE_TTY_P (d))
878 signal_simple_error ("Cannot change the class of this device", device);
879 if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale))
880 signal_simple_error ("Must be color, mono, or grayscale", class);
881 if (! EQ (DEVICE_CLASS (d), class))
884 DEVICE_CLASS (d) = class;
885 DEVICE_FRAME_LOOP (frmcons, d)
887 struct frame *f = XFRAME (XCAR (frmcons));
889 recompute_all_cached_specifiers_in_frame (f);
890 MARK_FRAME_FACES_CHANGED (f);
891 MARK_FRAME_GLYPHS_CHANGED (f);
892 MARK_FRAME_SUBWINDOWS_CHANGED (f);
893 MARK_FRAME_TOOLBARS_CHANGED (f);
894 MARK_FRAME_GUTTERS_CHANGED (f);
895 f->menubar_changed = 1;
901 DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /*
902 Set the output baud rate of DEVICE to RATE.
903 On most systems, changing this value will affect the amount of padding
904 and other strategic decisions made during redisplay.
910 DEVICE_BAUD_RATE (decode_device (device)) = XINT (rate);
915 DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /*
916 Return the output baud rate of DEVICE.
920 return make_int (DEVICE_BAUD_RATE (decode_device (device)));
923 DEFUN ("device-printer-p", Fdevice_printer_p, 0, 1, 0, /*
924 Return t if DEVICE is a printer, nil if it is a display. DEVICE defaults
925 to selected device if omitted, and must be live if specified.
929 return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil;
932 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
933 Get a metric for DEVICE as provided by the system.
935 METRIC must be a symbol specifying requested metric. Note that the metrics
936 returned are these provided by the system internally, not read from resources,
937 so obtained from the most internal level.
939 If a metric is not provided by the system, then DEFAULT is returned.
941 When DEVICE is nil, selected device is assumed
943 Metrics, by group, are:
945 COLORS. Colors are returned as valid color instantiators. No other assumption
946 on the returned value should be made (i.e. it can be a string on one system but
947 a color instance on another). For colors, returned value is a cons of
948 foreground and background colors. Note that if the system provides only one
949 color of the pair, the second one may be nil.
951 color-default Standard window text foreground and background.
952 color-select Selection highlight text and background colors.
953 color-balloon Balloon popup text and background colors.
954 color-3d-face 3-D object (button, modeline) text and surface colors.
955 color-3d-light Fore and back colors for 3-D edges facing light source.
956 color-3d-dark Fore and back colors for 3-D edges facing away from
958 color-menu Text and background for menus
959 color-menu-highlight Selected menu item colors
960 color-menu-button Menu button colors
961 color-menu-disabled Unselectable menu item colors
962 color-toolbar Toolbar foreground and background colors
963 color-scrollbar Scrollbar foreground and background colors
964 color-desktop Desktop window colors
965 color-workspace Workspace window colors
967 FONTS. Fonts are returned as valid font instantiators. No other assumption on
968 the returned value should be made (i.e. it can be a string on one system but
969 font instance on another).
971 font-default Default fixed width font.
972 font-menubar Menubar font
973 font-dialog Dialog boxes font
975 GEOMETRY. These metrics are returned as conses of (X . Y). As with colors,
976 either car or cdr of the cons may be nil if the system does not provide one
977 of the corresponding dimensions.
979 size-cursor Mouse cursor size.
980 size-scrollbar Scrollbars (WIDTH . HEIGHT)
981 size-menu Menubar height, as (nil . HEIGHT)
982 size-toolbar Toolbar width and height.
983 size-toolbar-button Toolbar button size.
984 size-toolbar-border Toolbar border width and height.
985 size-icon Icon dimensions.
986 size-icon-small Small icon dimensions.
987 size-device Device screen or paper size in pixels.
988 size-workspace Workspace size in pixels. This can be less than or
989 equal to the above. For diplays, this is the area
990 available to applications less window manager
991 decorations. For printers, this is the size of
993 offset-workspace Offset of workspace area from the top left corner
994 of screen or paper, in pixels.
995 size-device-mm Device screen size in millimeters.
996 device-dpi Device resolution, in dots per inch.
997 num-bit-planes Integer, number of device bit planes.
998 num-color-cells Integer, number of device color cells.
1000 FEATURES. This group reports various device features. If a feature is
1001 present, integer 1 (one) is returned, if it is not present, then integer
1002 0 (zero) is returned. If the system is unaware of the feature, then
1003 DEFAULT is returned.
1005 mouse-buttons Integer, number of mouse buttons, or zero if no mouse.
1006 swap-buttons Non-zero if left and right mouse buttons are swapped.
1007 show-sounds User preference for visual over audible bell.
1008 slow-device Device is slow, avoid animation.
1009 security Non-zero if user environment is secure.
1011 (device, metric, default_))
1013 struct device *d = decode_device (device);
1014 enum device_metrics m;
1019 else if (EQ (metric, Q##met)) \
1024 FROB (color_default);
1025 FROB (color_select);
1026 FROB (color_balloon);
1027 FROB (color_3d_face);
1028 FROB (color_3d_light);
1029 FROB (color_3d_dark);
1031 FROB (color_menu_highlight);
1032 FROB (color_menu_button);
1033 FROB (color_menu_disabled);
1034 FROB (color_toolbar);
1035 FROB (color_scrollbar);
1036 FROB (color_desktop);
1037 FROB (color_workspace);
1038 FROB (font_default);
1039 FROB (font_menubar);
1042 FROB (size_scrollbar);
1044 FROB (size_toolbar);
1045 FROB (size_toolbar_button);
1046 FROB (size_toolbar_border);
1048 FROB (size_icon_small);
1050 FROB (size_workspace);
1051 FROB (offset_workspace);
1052 FROB (size_device_mm);
1054 FROB (num_bit_planes);
1055 FROB (num_color_cells);
1056 FROB (mouse_buttons);
1057 FROB (swap_buttons);
1062 signal_simple_error ("Invalid device metric symbol", metric);
1064 res = DEVMETH_OR_GIVEN (d, device_system_metrics, (d, m), Qunbound);
1065 return UNBOUNDP(res) ? default_ : res;
1070 DEFUN ("device-system-metrics", Fdevice_system_metrics, 0, 1, 0, /*
1071 Get a property list of device metric for DEVICE.
1073 See `device-system-metric' for the description of available metrics.
1074 DEVICE defaults to selected device when omitted.
1078 struct device *d = decode_device (device);
1079 Lisp_Object plist = Qnil, one_metric;
1082 if (!UNBOUNDP ((one_metric = \
1083 DEVMETH_OR_GIVEN (d, device_system_metrics, \
1084 (d, DM_##m), Qunbound)))) \
1085 plist = Fcons (Q##m, Fcons (one_metric, plist));
1087 FROB (color_default);
1088 FROB (color_select);
1089 FROB (color_balloon);
1090 FROB (color_3d_face);
1091 FROB (color_3d_light);
1092 FROB (color_3d_dark);
1094 FROB (color_menu_highlight);
1095 FROB (color_menu_button);
1096 FROB (color_menu_disabled);
1097 FROB (color_toolbar);
1098 FROB (color_scrollbar);
1099 FROB (color_desktop);
1100 FROB (color_workspace);
1101 FROB (font_default);
1102 FROB (font_menubar);
1105 FROB (size_scrollbar);
1107 FROB (size_toolbar);
1108 FROB (size_toolbar_button);
1109 FROB (size_toolbar_border);
1111 FROB (size_icon_small);
1113 FROB (size_workspace);
1114 FROB (offset_workspace);
1115 FROB (size_device_mm);
1117 FROB (num_bit_planes);
1118 FROB (num_color_cells);
1119 FROB (mouse_buttons);
1120 FROB (swap_buttons);
1131 domain_device_type (Lisp_Object domain)
1133 /* This cannot GC */
1134 assert (WINDOWP (domain) || FRAMEP (domain)
1135 || DEVICEP (domain) || CONSOLEP (domain));
1137 if (WINDOWP (domain))
1139 if (!WINDOW_LIVE_P (XWINDOW (domain)))
1141 domain = WINDOW_FRAME (XWINDOW (domain));
1143 if (FRAMEP (domain))
1145 if (!FRAME_LIVE_P (XFRAME (domain)))
1147 domain = FRAME_DEVICE (XFRAME (domain));
1149 if (DEVICEP (domain))
1151 if (!DEVICE_LIVE_P (XDEVICE (domain)))
1153 domain = DEVICE_CONSOLE (XDEVICE (domain));
1155 return CONSOLE_TYPE (XCONSOLE (domain));
1159 * Determine whether window system bases window geometry on character
1161 * Return non-zero for pixel-based geometry, zero for character-based.
1164 window_system_pixelated_geometry (Lisp_Object domain)
1166 /* This cannot GC */
1167 Lisp_Object winsy = domain_device_type (domain);
1168 struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT);
1170 return (MAYBE_INT_CONTYPE_METH (meth, device_implementation_flags, ())
1171 & XDEVIMPF_PIXEL_GEOMETRY);
1174 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /*
1175 Return the device type symbol for a DOMAIN, e.g. 'x or 'tty.
1176 DOMAIN can be either a window, frame, device or console.
1180 if (!WINDOWP (domain) && !FRAMEP (domain)
1181 && !DEVICEP (domain) && !CONSOLEP (domain))
1183 ("Domain must be either a window, frame, device or console", domain);
1185 return domain_device_type (domain);
1189 handle_asynch_device_change (void)
1192 int old_asynch_device_change_pending = asynch_device_change_pending;
1193 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
1195 if (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1196 asynch_device_change_method)
1197 (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1198 asynch_device_change_method) ();
1200 /* reset the flag to 0 unless another notification occurred while
1201 we were processing this one. Block SIGWINCH during this
1202 check to prevent a possible race condition. */
1204 EMACS_BLOCK_SIGNAL (SIGWINCH);
1206 if (old_asynch_device_change_pending == asynch_device_change_pending)
1207 asynch_device_change_pending = 0;
1209 EMACS_UNBLOCK_SIGNAL (SIGWINCH);
1214 call_critical_lisp_code (struct device *d, Lisp_Object function,
1217 int old_gc_currently_forbidden = gc_currently_forbidden;
1218 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1220 /* There's no reason to bother doing specbinds here, because if
1221 initialize-*-faces signals an error, emacs is going to crash
1224 gc_currently_forbidden = 1;
1228 /* But it's useful to have an error handler; otherwise an infinite
1231 call1_with_handler (Qreally_early_error_handler, function, object);
1233 call0_with_handler (Qreally_early_error_handler, function);
1236 Vinhibit_quit = old_inhibit_quit;
1237 gc_currently_forbidden = old_gc_currently_forbidden;
1241 /************************************************************************/
1242 /* initialization */
1243 /************************************************************************/
1246 syms_of_device (void)
1248 INIT_LRECORD_IMPLEMENTATION (device);
1250 DEFSUBR (Fvalid_device_class_p);
1251 DEFSUBR (Fdevice_class_list);
1253 DEFSUBR (Fdfw_device);
1254 DEFSUBR (Fselected_device);
1255 DEFSUBR (Fselect_device);
1256 DEFSUBR (Fset_device_selected_frame);
1258 DEFSUBR (Fdevice_live_p);
1259 DEFSUBR (Fdevice_name);
1260 DEFSUBR (Fdevice_connection);
1261 DEFSUBR (Fdevice_console);
1262 DEFSUBR (Ffind_device);
1263 DEFSUBR (Fget_device);
1264 DEFSUBR (Fmake_device);
1265 DEFSUBR (Fdelete_device);
1266 DEFSUBR (Fdevice_frame_list);
1267 DEFSUBR (Fdevice_class);
1268 DEFSUBR (Fset_device_class);
1269 DEFSUBR (Fdevice_system_metrics);
1270 DEFSUBR (Fdevice_system_metric);
1271 DEFSUBR (Fset_device_baud_rate);
1272 DEFSUBR (Fdevice_baud_rate);
1273 DEFSUBR (Fdomain_device_type);
1274 DEFSUBR (Fdevice_printer_p);
1276 defsymbol (&Qdevicep, "devicep");
1277 defsymbol (&Qdevice_live_p, "device-live-p");
1279 defsymbol (&Qcreate_device_hook, "create-device-hook");
1280 defsymbol (&Qdelete_device_hook, "delete-device-hook");
1282 /* Qcolor defined in general.c */
1283 defsymbol (&Qgrayscale, "grayscale");
1284 defsymbol (&Qmono, "mono");
1286 /* Device metrics symbols */
1287 defsymbol (&Qcolor_default, "color-default");
1288 defsymbol (&Qcolor_select, "color-select");
1289 defsymbol (&Qcolor_balloon, "color-balloon");
1290 defsymbol (&Qcolor_3d_face, "color-3d-face");
1291 defsymbol (&Qcolor_3d_light, "color-3d-light");
1292 defsymbol (&Qcolor_3d_dark, "color-3d-dark");
1293 defsymbol (&Qcolor_menu, "color-menu");
1294 defsymbol (&Qcolor_menu_highlight, "color-menu-highlight");
1295 defsymbol (&Qcolor_menu_button, "color-menu-button");
1296 defsymbol (&Qcolor_menu_disabled, "color-menu-disabled");
1297 defsymbol (&Qcolor_toolbar, "color-toolbar");
1298 defsymbol (&Qcolor_scrollbar, "color-scrollbar");
1299 defsymbol (&Qcolor_desktop, "color-desktop");
1300 defsymbol (&Qcolor_workspace, "color-workspace");
1301 defsymbol (&Qfont_default, "font-default");
1302 defsymbol (&Qfont_menubar, "font-menubar");
1303 defsymbol (&Qfont_dialog, "font-dialog");
1304 defsymbol (&Qsize_cursor, "size-cursor");
1305 defsymbol (&Qsize_scrollbar, "size-scrollbar");
1306 defsymbol (&Qsize_menu, "size-menu");
1307 defsymbol (&Qsize_toolbar, "size-toolbar");
1308 defsymbol (&Qsize_toolbar_button, "size-toolbar-button");
1309 defsymbol (&Qsize_toolbar_border, "size-toolbar-border");
1310 defsymbol (&Qsize_icon, "size-icon");
1311 defsymbol (&Qsize_icon_small, "size-icon-small");
1312 defsymbol (&Qsize_device, "size-device");
1313 defsymbol (&Qsize_workspace, "size-workspace");
1314 defsymbol (&Qoffset_workspace, "offset-workspace");
1315 defsymbol (&Qsize_device_mm, "size-device-mm");
1316 defsymbol (&Qnum_bit_planes, "num-bit-planes");
1317 defsymbol (&Qnum_color_cells, "num-color-cells");
1318 defsymbol (&Qdevice_dpi, "device-dpi");
1319 defsymbol (&Qmouse_buttons, "mouse-buttons");
1320 defsymbol (&Qswap_buttons, "swap-buttons");
1321 defsymbol (&Qshow_sounds, "show-sounds");
1322 defsymbol (&Qslow_device, "slow-device");
1323 defsymbol (&Qsecurity, "security");
1327 reinit_vars_of_device (void)
1329 staticpro_nodump (&Vdefault_device);
1330 Vdefault_device = Qnil;
1331 asynch_device_change_pending = 0;
1335 vars_of_device (void)
1337 reinit_vars_of_device ();
1339 DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /*
1340 Function or functions to call when a device is created.
1341 One argument, the newly-created device.
1342 This is called after the first frame has been created, but before
1343 calling the `create-frame-hook'.
1344 Note that in general the device will not be selected.
1346 Vcreate_device_hook = Qnil;
1348 DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook /*
1349 Function or functions to call when a device is deleted.
1350 One argument, the to-be-deleted device.
1352 Vdelete_device_hook = Qnil;
1354 Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono);
1355 staticpro (&Vdevice_class_list);
1357 /* Death to devices.el !!! */
1358 Fprovide(intern("devices"));