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 Qdelete_device;
77 Lisp_Object Qcreate_device_hook;
78 Lisp_Object Qdelete_device_hook;
79 Lisp_Object Vdevice_class_list;
83 mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object))
85 struct device *d = XDEVICE (obj);
88 markobj (d->connection);
89 markobj (d->canon_connection);
91 markobj (d->selected_frame);
92 markobj (d->frame_with_focus_real);
93 markobj (d->frame_with_focus_for_hooks);
94 markobj (d->frame_that_ought_to_have_focus);
95 markobj (d->device_class);
96 markobj (d->user_defined_tags);
97 markobj (d->pixel_to_glyph_cache.obj1);
98 markobj (d->pixel_to_glyph_cache.obj2);
100 markobj (d->color_instance_cache);
101 markobj (d->font_instance_cache);
103 markobj (d->charset_font_cache);
105 markobj (d->image_instance_cache);
109 markobj (d->devmeths->symbol);
110 MAYBE_DEVMETH (d, mark_device, (d, markobj));
113 return (d->frame_list);
117 print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
119 struct device *d = XDEVICE (obj);
123 error ("printing unreadable object #<device %s 0x%x>",
124 XSTRING_DATA (d->name), d->header.uid);
126 sprintf (buf, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" :
127 DEVICE_TYPE_NAME (d));
128 write_c_string (buf, printcharfun);
129 if (DEVICE_LIVE_P (d))
131 write_c_string (" on ", printcharfun);
132 print_internal (DEVICE_CONNECTION (d), printcharfun, 1);
134 sprintf (buf, " 0x%x>", d->header.uid);
135 write_c_string (buf, printcharfun);
138 DEFINE_LRECORD_IMPLEMENTATION ("device", device,
139 mark_device, print_device, 0, 0, 0,
143 valid_device_class_p (Lisp_Object class)
145 return !NILP (memq_no_quit (class, Vdevice_class_list));
148 DEFUN ("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0, /*
149 Given a DEVICE-CLASS, return t if it is valid.
150 Valid classes are 'color, 'grayscale, and 'mono.
154 return valid_device_class_p (device_class) ? Qt : Qnil;
157 DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /*
158 Return a list of valid device classes.
162 return Fcopy_sequence (Vdevice_class_list);
165 static struct device *
166 allocate_device (Lisp_Object console)
169 struct device *d = alloc_lcrecord_type (struct device, &lrecord_device);
174 XSETDEVICE (device, d);
178 d->console = console;
179 d->connection = Qnil;
180 d->canon_connection = Qnil;
181 d->frame_list = Qnil;
182 d->selected_frame = Qnil;
183 d->frame_with_focus_real = Qnil;
184 d->frame_with_focus_for_hooks = Qnil;
185 d->frame_that_ought_to_have_focus = Qnil;
186 d->device_class = Qnil;
187 d->user_defined_tags = Qnil;
188 d->pixel_to_glyph_cache.obj1 = Qnil;
189 d->pixel_to_glyph_cache.obj2 = Qnil;
191 d->infd = d->outfd = -1;
193 /* #### is 20 reasonable? */
194 d->color_instance_cache =
195 make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL);
196 d->font_instance_cache =
197 make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL);
199 /* Note that the following table is bi-level. */
200 d->charset_font_cache =
201 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
204 Note that the image instance cache is actually bi-level.
205 See device.h. We use a low number here because most of the
206 time there aren't very many different masks that will be used.
208 d->image_instance_cache =
209 make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
216 decode_device (Lisp_Object device)
219 device = Fselected_device (Qnil);
220 /* quietly accept frames for the device arg */
221 else if (FRAMEP (device))
222 device = FRAME_DEVICE (decode_frame (device));
223 CHECK_LIVE_DEVICE (device);
224 return XDEVICE (device);
227 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /*
228 Given a device, frame, or window, return the associated device.
229 Return nil otherwise.
233 return DFW_DEVICE (obj);
237 DEFUN ("selected-device", Fselected_device, 0, 1, 0, /*
238 Return the device which is currently active.
239 If optional CONSOLE is non-nil, return the device that would be currently
240 active if CONSOLE were the selected console.
244 if (NILP (console) && NILP (Vselected_console))
245 return Qnil; /* happens early in temacs */
246 return CONSOLE_SELECTED_DEVICE (decode_console (console));
249 /* Called from selected_frame_1(), called from Fselect_window() */
251 select_device_1 (Lisp_Object device)
253 struct device *dev = XDEVICE (device);
254 Lisp_Object old_selected_device = Fselected_device (Qnil);
256 if (EQ (device, old_selected_device))
259 /* now select the device's console */
260 CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (dev))) = device;
261 select_console_1 (DEVICE_CONSOLE (dev));
264 DEFUN ("select-device", Fselect_device, 1, 1, 0, /*
265 Select the device DEVICE.
266 Subsequent editing commands apply to its console, selected frame,
268 The selection of DEVICE lasts until the next time the user does
269 something to select a different device, or until the next time this
274 CHECK_LIVE_DEVICE (device);
276 /* select the device's selected frame's selected window. This will call
277 selected_frame_1()->selected_device_1()->selected_console_1(). */
278 if (!NILP (DEVICE_SELECTED_FRAME (XDEVICE (device))))
279 Fselect_window (FRAME_SELECTED_WINDOW
280 (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device)))),
283 error ("Can't select a device with no frames");
288 set_device_selected_frame (struct device *d, Lisp_Object frame)
290 if (!NILP (frame) && !FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
291 set_console_last_nonminibuf_frame (XCONSOLE (DEVICE_CONSOLE (d)), frame);
292 d->selected_frame = frame;
295 DEFUN ("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /*
296 Set the selected frame of device object DEVICE to FRAME.
297 If DEVICE is nil, the selected device is used.
298 If DEVICE is the selected device, this makes FRAME the selected frame.
302 XSETDEVICE (device, decode_device (device));
303 CHECK_LIVE_FRAME (frame);
305 if (! EQ (device, FRAME_DEVICE (XFRAME (frame))))
306 error ("In `set-device-selected-frame', FRAME is not on DEVICE");
308 if (EQ (device, Fselected_device (Qnil)))
309 return Fselect_frame (frame);
311 set_device_selected_frame (XDEVICE (device), frame);
315 DEFUN ("devicep", Fdevicep, 1, 1, 0, /*
316 Return non-nil if OBJECT is a device.
320 return DEVICEP (object) ? Qt : Qnil;
323 DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /*
324 Return non-nil if OBJECT is a device that has not been deleted.
328 return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil;
331 DEFUN ("device-name", Fdevice_name, 0, 1, 0, /*
332 Return the name of the specified device.
333 DEVICE defaults to the selected device if omitted.
337 return DEVICE_NAME (decode_device (device));
340 DEFUN ("device-connection", Fdevice_connection, 0, 1, 0, /*
341 Return the connection of the specified device.
342 DEVICE defaults to the selected device if omitted.
346 return DEVICE_CONNECTION (decode_device (device));
349 DEFUN ("device-console", Fdevice_console, 0, 1, 0, /*
350 Return the console of the specified device.
351 DEVICE defaults to the selected device if omitted.
355 return DEVICE_CONSOLE (decode_device (device));
358 #ifdef HAVE_WINDOW_SYSTEM
361 init_global_resources (struct device *d)
363 init_global_faces (d);
364 #ifdef HAVE_SCROLLBARS
365 init_global_scrollbars (d);
368 init_global_toolbars (d);
375 init_device_resources (struct device *d)
377 init_device_faces (d);
378 #ifdef HAVE_SCROLLBARS
379 init_device_scrollbars (d);
382 init_device_toolbars (d);
387 semi_canonicalize_device_connection (struct console_methods *meths,
388 Lisp_Object name, Error_behavior errb)
390 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection,
395 canonicalize_device_connection (struct console_methods *meths,
396 Lisp_Object name, Error_behavior errb)
398 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection,
403 find_device_of_type (struct console_methods *meths, Lisp_Object canon)
405 Lisp_Object devcons, concons;
407 DEVICE_LOOP_NO_BREAK (devcons, concons)
409 Lisp_Object device = XCAR (devcons);
411 if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device)))
412 && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)),
420 DEFUN ("find-device", Ffind_device, 1, 2, 0, /*
421 Look for an existing device attached to connection CONNECTION.
422 Return the device if found; otherwise, return nil.
424 If TYPE is specified, only return devices of that type; otherwise,
425 return devices of any type. (It is possible, although unlikely,
426 that two devices of different types could have the same connection
427 name; in such a case, the first device found is returned.)
431 Lisp_Object canon = Qnil;
438 struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
439 canon = canonicalize_device_connection (conmeths, connection,
441 if (UNBOUNDP (canon))
442 RETURN_UNGCPRO (Qnil);
444 RETURN_UNGCPRO (find_device_of_type (conmeths, canon));
450 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
452 struct console_methods *conmeths =
453 Dynarr_at (the_console_type_entry_dynarr, i).meths;
454 canon = canonicalize_device_connection (conmeths, connection,
456 if (!UNBOUNDP (canon))
458 Lisp_Object device = find_device_of_type (conmeths, canon);
460 RETURN_UNGCPRO (device);
464 RETURN_UNGCPRO (Qnil);
468 DEFUN ("get-device", Fget_device, 1, 2, 0, /*
469 Look for an existing device attached to connection CONNECTION.
470 Return the device if found; otherwise, signal an error.
472 If TYPE is specified, only return devices of that type; otherwise,
473 return devices of any type. (It is possible, although unlikely,
474 that two devices of different types could have the same connection
475 name; in such a case, the first device found is returned.)
479 Lisp_Object device = Ffind_device (connection, type);
483 signal_simple_error ("No such device", connection);
485 signal_simple_error_2 ("No such device", type, connection);
491 delete_deviceless_console (Lisp_Object console)
493 if (NILP (XCONSOLE (console)->device_list))
494 Fdelete_console (console, Qnil);
498 DEFUN ("make-device", Fmake_device, 2, 3, 0, /*
499 Return a new device of type TYPE, attached to connection CONNECTION.
501 The valid values for CONNECTION are device-specific; however,
502 CONNECTION is generally a string. (Specifically, for X devices,
503 CONNECTION should be a display specification such as "foo:0", and
504 for TTY devices, CONNECTION should be the filename of a TTY device
505 file, such as "/dev/ttyp4", or nil to refer to XEmacs' standard
508 PROPS, if specified, should be a plist of properties controlling
511 If CONNECTION specifies an already-existing device connection, that
512 device is simply returned; no new device is created, and PROPS
515 (type, connection, props))
517 /* This function can GC */
520 Lisp_Object device = Qnil;
521 Lisp_Object console = Qnil;
522 Lisp_Object name = Qnil;
523 struct console_methods *conmeths;
524 int speccount = specpdl_depth();
526 struct gcpro gcpro1, gcpro2, gcpro3;
527 #ifdef HAVE_X_WINDOWS
528 /* #### icky-poo. If this is the first X device we are creating,
529 then retrieve the global face resources. We have to do it
530 here, at the same time as (or just before) the device face
531 resources are retrieved; specifically, it needs to be done
532 after the device has been created but before any frames have
533 been popped up or much anything else has been done. It's
534 possible for other devices to specify different global
535 resources (there's a property on each X server's root window
536 that holds some resources); tough luck for the moment.
538 This is a nasty violation of device independence, but
539 there's not a whole lot I can figure out to do about it.
540 The real problem is that the concept of resources is not
541 generalized away from X. Similar resource-related
542 device-independence violations occur in faces.el. */
543 int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx);
546 GCPRO3 (device, console, name);
548 conmeths = decode_console_type (type, ERROR_ME_NOT);
550 signal_simple_error ("Invalid device type", type);
552 device = Ffind_device (connection, type);
554 RETURN_UNGCPRO (device);
556 name = Fplist_get (props, Qname, Qnil);
559 Lisp_Object conconnect =
560 (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ?
561 CONTYPE_METH (conmeths, device_to_console_connection,
562 (connection, ERROR_ME)) :
564 console = create_console (name, type, conconnect, props);
567 record_unwind_protect(delete_deviceless_console, console);
569 con = XCONSOLE (console);
570 d = allocate_device (console);
571 XSETDEVICE (device, d);
573 d->devmeths = con->conmeths;
575 DEVICE_NAME (d) = name;
576 DEVICE_CONNECTION (d) =
577 semi_canonicalize_device_connection (conmeths, connection, ERROR_ME);
578 DEVICE_CANON_CONNECTION (d) =
579 canonicalize_device_connection (conmeths, connection, ERROR_ME);
581 MAYBE_DEVMETH (d, init_device, (d, props));
583 /* Do it this way so that the device list is in order of creation */
584 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil));
585 RESET_CHANGED_SET_FLAGS;
586 if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device)))
587 Vdefault_device = device;
589 init_device_sound (d);
590 #ifdef HAVE_X_WINDOWS
592 init_global_resources (d);
594 init_device_resources (d);
596 MAYBE_DEVMETH (d, finish_init_device, (d, props));
598 /* If this is the first device on the console, make it the selected one. */
599 if (NILP (CONSOLE_SELECTED_DEVICE (con)))
600 CONSOLE_SELECTED_DEVICE (con) = device;
602 /* #### the following should trap errors. */
603 setup_device_initial_specifier_tags (d);
606 unbind_to(speccount, Qnil);
610 /* find a device other than the selected one. Prefer non-stream
611 devices over stream devices. Maybe stay on the same console. */
614 find_other_device (Lisp_Object device, int on_same_console)
616 Lisp_Object devcons = Qnil, concons;
617 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device));
619 /* look for a non-stream device */
620 DEVICE_LOOP_NO_BREAK (devcons, concons)
622 Lisp_Object dev = XCAR (devcons);
623 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
625 if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) &&
626 !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
632 return XCAR (devcons);
634 /* OK, now look for a stream device */
635 DEVICE_LOOP_NO_BREAK (devcons, concons)
637 Lisp_Object dev = XCAR (devcons);
638 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
640 if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
645 return XCAR (devcons);
647 /* Sorry, there ain't none */
652 find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame,
657 VOID_TO_LISP (device, closure);
658 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
660 if (EQ (device, FRAME_DEVICE (XFRAME (frame))))
666 find_nonminibuffer_frame_not_on_device (Lisp_Object device)
668 return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate,
669 LISP_TO_VOID (device));
675 If FORCE is non-zero, allow deletion of the only frame.
677 If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if
678 deleting the last device on a console, just delete it,
679 instead of calling `delete-console'.
681 If FROM_IO_ERROR is non-zero, then the device is gone due
682 to an I/O error. This affects what happens if we exit
683 (we do an emergency exit instead of `save-buffers-kill-emacs'.)
687 delete_device_internal (struct device *d, int force,
688 int called_from_delete_console,
691 /* This function can GC */
696 /* OK to delete an already-deleted device. */
697 if (!DEVICE_LIVE_P (d))
700 XSETDEVICE (device, d);
703 c = XCONSOLE (DEVICE_CONSOLE (d));
705 if (!called_from_delete_console)
707 int delete_console = 0;
708 /* If we're deleting the only device on the console,
709 delete the console. */
710 if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1)
711 /* if we just created the device, it might not be listed,
713 && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c))))
715 /* Or if there aren't any nonminibuffer frames that would be
716 left, delete the console (this will make XEmacs exit). */
717 else if (NILP (find_nonminibuffer_frame_not_on_device (device)))
722 delete_console_internal (c, force, 0, from_io_error);
728 reset_one_device (d);
733 /* First delete all frames without their own minibuffers,
734 to avoid errors coming from attempting to delete a frame
735 that is a surrogate for another frame. */
736 DEVICE_FRAME_LOOP (frmcons, d)
738 struct frame *f = XFRAME (XCAR (frmcons));
739 /* delete_frame_internal() might do anything such as run hooks,
741 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
742 delete_frame_internal (f, 1, 1, from_io_error);
744 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
745 go ahead and delete anything */
752 /* #### This should probably be a device method but it is time for
753 19.14 to go out the door. */
754 #ifdef HAVE_X_WINDOWS
755 /* Next delete all frames which have the popup property to avoid
756 deleting a child after its parent. */
757 DEVICE_FRAME_LOOP (frmcons, d)
759 struct frame *f = XFRAME (XCAR (frmcons));
761 if (FRAME_LIVE_P (f))
763 Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil);
765 delete_frame_internal (f, 1, 1, from_io_error);
767 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
768 go ahead and delete anything */
775 #endif /* HAVE_X_WINDOWS */
777 DEVICE_FRAME_LOOP (frmcons, d)
779 struct frame *f = XFRAME (XCAR (frmcons));
780 /* delete_frame_internal() might do anything such as run hooks,
782 if (FRAME_LIVE_P (f))
783 delete_frame_internal (f, 1, 1, from_io_error);
785 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
786 go ahead and delete anything */
794 set_device_selected_frame (d, Qnil);
796 /* try to select another device */
798 if (EQ (device, Fselected_device (DEVICE_CONSOLE (d))))
800 Lisp_Object other_dev = find_other_device (device, 1);
801 if (!NILP (other_dev))
802 Fselect_device (other_dev);
805 if (EQ (device, Vdefault_device))
806 Vdefault_device = find_other_device (device, 0);
808 MAYBE_DEVMETH (d, delete_device, (d));
810 CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c));
811 RESET_CHANGED_SET_FLAGS;
812 d->devmeths = dead_console_methods;
816 /* delete a device as a result of an I/O error. Called from
817 an enqueued magic-eval event. */
820 io_error_delete_device (Lisp_Object device)
822 /* Note: it's the console that should get deleted, but
823 delete_device_internal() contains a hack that also deletes the
824 console when called from this function. */
825 delete_device_internal (XDEVICE (device), 1, 0, 1);
828 DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /*
829 Delete DEVICE, permanently eliminating it from use.
830 Normally, you cannot delete the last non-minibuffer-only frame (you must
831 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
832 second argument FORCE is non-nil, you can delete the last frame. (This
833 will automatically call `save-buffers-kill-emacs'.)
837 CHECK_DEVICE (device);
838 delete_device_internal (XDEVICE (device), !NILP (force), 0, 0);
842 DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /*
843 Return a list of all frames on DEVICE.
844 If DEVICE is nil, the selected device will be used.
848 return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device)));
851 DEFUN ("device-class", Fdevice_class, 0, 1, 0, /*
852 Return the class (color behavior) of DEVICE.
853 This will be one of 'color, 'grayscale, or 'mono.
857 return DEVICE_CLASS (decode_device (device));
860 DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /*
861 Set the class (color behavior) of DEVICE.
862 CLASS should be one of 'color, 'grayscale, or 'mono.
863 This is only allowed on device such as TTY devices, where the color
864 behavior cannot necessarily be determined automatically.
868 struct device *d = decode_device (device);
869 XSETDEVICE (device, d);
870 if (!DEVICE_TTY_P (d))
871 signal_simple_error ("Cannot change the class of this device", device);
872 if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale))
873 signal_simple_error ("Must be color, mono, or grayscale", class);
874 if (! EQ (DEVICE_CLASS (d), class))
877 DEVICE_CLASS (d) = class;
878 DEVICE_FRAME_LOOP (frmcons, d)
880 struct frame *f = XFRAME (XCAR (frmcons));
882 recompute_all_cached_specifiers_in_frame (f);
883 MARK_FRAME_FACES_CHANGED (f);
884 MARK_FRAME_GLYPHS_CHANGED (f);
885 MARK_FRAME_SUBWINDOWS_CHANGED (f);
886 MARK_FRAME_TOOLBARS_CHANGED (f);
887 f->menubar_changed = 1;
893 DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /*
894 Set the output baud rate of DEVICE to RATE.
895 On most systems, changing this value will affect the amount of padding
896 and other strategic decisions made during redisplay.
902 DEVICE_BAUD_RATE (decode_device (device)) = XINT (rate);
907 DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /*
908 Return the output baud rate of DEVICE.
912 return make_int (DEVICE_BAUD_RATE (decode_device (device)));
915 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
916 Get a metric for DEVICE as provided by the system.
918 METRIC must be a symbol specifying requested metric. Note that the metrics
919 returned are these provided by the system internally, not read from resources,
920 so obtained from the most internal level.
922 If a metric is not provided by the system, then DEFAULT is returned.
924 When DEVICE is nil, selected device is assumed
926 Metrics, by group, are:
928 COLORS. Colors are returned as valid color instantiators. No other assumption
929 on the returned value should be made (i.e. it can be a string on one system but
930 a color instance on another). For colors, returned value is a cons of
931 foreground and background colors. Note that if the system provides only one
932 color of the pair, the second one may be nil.
934 color-default Standard window text foreground and background.
935 color-select Selection highlight text and background colors.
936 color-balloon Balloon popup text and background colors.
937 color-3d-face 3-D object (button, modeline) text and surface colors.
938 color-3d-light Fore and back colors for 3-D edges facing light source.
939 color-3d-dark Fore and back colors for 3-D edges facing away from
941 color-menu Text and background for menus
942 color-menu-highlight Selected menu item colors
943 color-menu-button Menu button colors
944 color-menu-disabled Unselectable menu item colors
945 color-toolbar Toolbar foreground and background colors
946 color-scrollbar Scrollbar foreground and background colors
947 color-desktop Desktop window colors
948 color-workspace Workspace window colors
950 FONTS. Fonts are returned as valid font instantiators. No other assumption on
951 the returned value should be made (i.e. it can be a string on one system but
952 font instance on another).
954 font-default Default fixed width font.
955 font-menubar Menubar font
956 font-dialog Dialog boxes font
958 GEOMETRY. These metrics are returned as conses of (X . Y). As with colors,
959 either car or cdr of the cons may be nil if the system does not provide one
960 of the corresponding dimensions.
962 size-cursor Mouse cursor size.
963 size-scrollbar Scrollbars (WIDTH . HEIGHT)
964 size-menu Menubar height, as (nil . HEIGHT)
965 size-toolbar Toolbar width and height.
966 size-toolbar-button Toolbar button size.
967 size-toolbar-border Toolbar border width and height.
968 size-icon Icon dimensions.
969 size-icon-small Small icon dimensions.
970 size-device Device screen size in pixels.
971 size-workspace Workspace size in pixels. This can be less than the
972 above if window manager has decorations which
973 effectively shrink the area remaining for application
975 size-device-mm Device screen size in millimeters.
976 device-dpi Device resolution, in dots per inch.
977 num-bit-planes Integer, number of device bit planes.
978 num-color-cells Integer, number of device color cells.
980 FEATURES. This group reports various device features. If a feature is
981 present, integer 1 (one) is returned, if it is not present, then integer
982 0 (zero) is returned. If the system is unaware of the feature, then
985 mouse-buttons Integer, number of mouse buttons, or zero if no mouse.
986 swap-buttons Non-zero if left and right mouse buttons are swapped.
987 show-sounds User preference for visual over audible bell.
988 slow-device Device is slow, avoid animation.
989 security Non-zero if user environment is secure.
991 (device, metric, default_))
993 struct device *d = decode_device (device);
994 enum device_metrics m;
999 else if (EQ (metric, Q##met)) \
1004 FROB (color_default);
1005 FROB (color_select);
1006 FROB (color_balloon);
1007 FROB (color_3d_face);
1008 FROB (color_3d_light);
1009 FROB (color_3d_dark);
1011 FROB (color_menu_highlight);
1012 FROB (color_menu_button);
1013 FROB (color_menu_disabled);
1014 FROB (color_toolbar);
1015 FROB (color_scrollbar);
1016 FROB (color_desktop);
1017 FROB (color_workspace);
1018 FROB (font_default);
1019 FROB (font_menubar);
1022 FROB (size_scrollbar);
1024 FROB (size_toolbar);
1025 FROB (size_toolbar_button);
1026 FROB (size_toolbar_border);
1028 FROB (size_icon_small);
1030 FROB (size_workspace);
1031 FROB (size_device_mm);
1033 FROB (num_bit_planes);
1034 FROB (num_color_cells);
1035 FROB (mouse_buttons);
1036 FROB (swap_buttons);
1041 signal_simple_error ("Invalid device metric symbol", metric);
1043 res = DEVMETH_OR_GIVEN (d, device_system_metrics, (d, m), Qunbound);
1044 return UNBOUNDP(res) ? default_ : res;
1049 DEFUN ("device-system-metrics", Fdevice_system_metrics, 0, 1, 0, /*
1050 Get a property list of device metric for DEVICE.
1052 See `device-system-metric' for the description of available metrics.
1053 DEVICE defaults to selected device when omitted.
1057 struct device *d = decode_device (device);
1058 Lisp_Object plist = Qnil, one_metric;
1061 if (!UNBOUNDP ((one_metric = \
1062 DEVMETH_OR_GIVEN (d, device_system_metrics, \
1063 (d, DM_##m), Qunbound)))) \
1064 plist = Fcons (Q##m, Fcons (one_metric, plist));
1066 FROB (color_default);
1067 FROB (color_select);
1068 FROB (color_balloon);
1069 FROB (color_3d_face);
1070 FROB (color_3d_light);
1071 FROB (color_3d_dark);
1073 FROB (color_menu_highlight);
1074 FROB (color_menu_button);
1075 FROB (color_menu_disabled);
1076 FROB (color_toolbar);
1077 FROB (color_scrollbar);
1078 FROB (color_desktop);
1079 FROB (color_workspace);
1080 FROB (font_default);
1081 FROB (font_menubar);
1084 FROB (size_scrollbar);
1086 FROB (size_toolbar);
1087 FROB (size_toolbar_button);
1088 FROB (size_toolbar_border);
1090 FROB (size_icon_small);
1092 FROB (size_workspace);
1093 FROB (size_device_mm);
1095 FROB (num_bit_planes);
1096 FROB (num_color_cells);
1097 FROB (mouse_buttons);
1098 FROB (swap_buttons);
1109 domain_device_type (Lisp_Object domain)
1111 /* This cannot GC */
1112 assert (WINDOWP (domain) || FRAMEP (domain)
1113 || DEVICEP (domain) || CONSOLEP (domain));
1115 if (WINDOWP (domain))
1117 if (!WINDOW_LIVE_P (XWINDOW (domain)))
1119 domain = WINDOW_FRAME (XWINDOW (domain));
1121 if (FRAMEP (domain))
1123 if (!FRAME_LIVE_P (XFRAME (domain)))
1125 domain = FRAME_DEVICE (XFRAME (domain));
1127 if (DEVICEP (domain))
1129 if (!DEVICE_LIVE_P (XDEVICE (domain)))
1131 domain = DEVICE_CONSOLE (XDEVICE (domain));
1133 return CONSOLE_TYPE (XCONSOLE (domain));
1137 * Determine whether window system bases window geometry on character
1139 * Return non-zero for pixel-based geometry, zero for character-based.
1142 window_system_pixelated_geometry (Lisp_Object domain)
1144 /* This cannot GC */
1145 Lisp_Object winsy = domain_device_type (domain);
1146 struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT);
1148 return (MAYBE_INT_CONTYPE_METH (meth, device_implementation_flags, ())
1149 & XDEVIMPF_PIXEL_GEOMETRY);
1152 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /*
1153 Return the device type symbol for a DOMAIN, e.g. 'x or 'tty.
1154 DOMAIN can be either a window, frame, device or console.
1158 if (!WINDOWP (domain) && !FRAMEP (domain)
1159 && !DEVICEP (domain) && !CONSOLEP (domain))
1161 ("Domain must be either a window, frame, device or console", domain);
1163 return domain_device_type (domain);
1167 handle_asynch_device_change (void)
1170 int old_asynch_device_change_pending = asynch_device_change_pending;
1171 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
1173 if (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1174 asynch_device_change_method)
1175 (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1176 asynch_device_change_method) ();
1178 /* reset the flag to 0 unless another notification occurred while
1179 we were processing this one. Block SIGWINCH during this
1180 check to prevent a possible race condition. */
1182 EMACS_BLOCK_SIGNAL (SIGWINCH);
1184 if (old_asynch_device_change_pending == asynch_device_change_pending)
1185 asynch_device_change_pending = 0;
1187 EMACS_UNBLOCK_SIGNAL (SIGWINCH);
1192 call_critical_lisp_code (struct device *d, Lisp_Object function,
1195 int old_gc_currently_forbidden = gc_currently_forbidden;
1196 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1198 /* There's no reason to bother doing specbinds here, because if
1199 initialize-*-faces signals an error, emacs is going to crash
1202 gc_currently_forbidden = 1;
1206 /* But it's useful to have an error handler; otherwise an infinite
1209 call1_with_handler (Qreally_early_error_handler, function, object);
1211 call0_with_handler (Qreally_early_error_handler, function);
1214 Vinhibit_quit = old_inhibit_quit;
1215 gc_currently_forbidden = old_gc_currently_forbidden;
1219 /************************************************************************/
1220 /* initialization */
1221 /************************************************************************/
1224 syms_of_device (void)
1226 DEFSUBR (Fvalid_device_class_p);
1227 DEFSUBR (Fdevice_class_list);
1229 DEFSUBR (Fdfw_device);
1230 DEFSUBR (Fselected_device);
1231 DEFSUBR (Fselect_device);
1232 DEFSUBR (Fset_device_selected_frame);
1234 DEFSUBR (Fdevice_live_p);
1235 DEFSUBR (Fdevice_name);
1236 DEFSUBR (Fdevice_connection);
1237 DEFSUBR (Fdevice_console);
1238 DEFSUBR (Ffind_device);
1239 DEFSUBR (Fget_device);
1240 DEFSUBR (Fmake_device);
1241 DEFSUBR (Fdelete_device);
1242 DEFSUBR (Fdevice_frame_list);
1243 DEFSUBR (Fdevice_class);
1244 DEFSUBR (Fset_device_class);
1245 DEFSUBR (Fdevice_system_metrics);
1246 DEFSUBR (Fdevice_system_metric);
1247 DEFSUBR (Fset_device_baud_rate);
1248 DEFSUBR (Fdevice_baud_rate);
1249 DEFSUBR (Fdomain_device_type);
1251 defsymbol (&Qdevicep, "devicep");
1252 defsymbol (&Qdevice_live_p, "device-live-p");
1253 defsymbol (&Qdelete_device, "delete-device");
1255 defsymbol (&Qcreate_device_hook, "create-device-hook");
1256 defsymbol (&Qdelete_device_hook, "delete-device-hook");
1258 /* Qcolor defined in general.c */
1259 defsymbol (&Qgrayscale, "grayscale");
1260 defsymbol (&Qmono, "mono");
1262 /* Device metrics symbols */
1263 defsymbol (&Qcolor_default, "color-default");
1264 defsymbol (&Qcolor_select, "color-select");
1265 defsymbol (&Qcolor_balloon, "color-balloon");
1266 defsymbol (&Qcolor_3d_face, "color-3d-face");
1267 defsymbol (&Qcolor_3d_light, "color-3d-light");
1268 defsymbol (&Qcolor_3d_dark, "color-3d-dark");
1269 defsymbol (&Qcolor_menu, "color-menu");
1270 defsymbol (&Qcolor_menu_highlight, "color-menu-highlight");
1271 defsymbol (&Qcolor_menu_button, "color-menu-button");
1272 defsymbol (&Qcolor_menu_disabled, "color-menu-disabled");
1273 defsymbol (&Qcolor_toolbar, "color-toolbar");
1274 defsymbol (&Qcolor_scrollbar, "color-scrollbar");
1275 defsymbol (&Qcolor_desktop, "color-desktop");
1276 defsymbol (&Qcolor_workspace, "color-workspace");
1277 defsymbol (&Qfont_default, "font-default");
1278 defsymbol (&Qfont_menubar, "font-menubar");
1279 defsymbol (&Qfont_dialog, "font-dialog");
1280 defsymbol (&Qsize_cursor, "size-cursor");
1281 defsymbol (&Qsize_scrollbar, "size-scrollbar");
1282 defsymbol (&Qsize_menu, "size-menu");
1283 defsymbol (&Qsize_toolbar, "size-toolbar");
1284 defsymbol (&Qsize_toolbar_button, "size-toolbar-button");
1285 defsymbol (&Qsize_toolbar_border, "size-toolbar-border");
1286 defsymbol (&Qsize_icon, "size-icon");
1287 defsymbol (&Qsize_icon_small, "size-icon-small");
1288 defsymbol (&Qsize_device, "size-device");
1289 defsymbol (&Qsize_workspace, "size-workspace");
1290 defsymbol (&Qsize_device_mm, "size-device-mm");
1291 defsymbol (&Qnum_bit_planes, "num-bit-planes");
1292 defsymbol (&Qnum_color_cells, "num-color-cells");
1293 defsymbol (&Qdevice_dpi, "device-dpi");
1294 defsymbol (&Qmouse_buttons, "mouse-buttons");
1295 defsymbol (&Qswap_buttons, "swap-buttons");
1296 defsymbol (&Qshow_sounds, "show-sounds");
1297 defsymbol (&Qslow_device, "slow-device");
1298 defsymbol (&Qsecurity, "security");
1302 vars_of_device (void)
1304 DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /*
1305 Function or functions to call when a device is created.
1306 One argument, the newly-created device.
1307 This is called after the first frame has been created, but before
1308 calling the `create-frame-hook'.
1309 Note that in general the device will not be selected.
1311 Vcreate_device_hook = Qnil;
1313 DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook /*
1314 Function or functions to call when a device is deleted.
1315 One argument, the to-be-deleted device.
1317 Vdelete_device_hook = Qnil;
1319 staticpro (&Vdefault_device);
1320 Vdefault_device = Qnil;
1322 asynch_device_change_pending = 0;
1324 Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono);
1325 staticpro (&Vdevice_class_list);
1327 /* Death to devices.el !!! */
1328 Fprovide(intern("devices"));