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;
80 Lisp_Object Vdevice_class_list;
84 mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object))
86 struct device *d = XDEVICE (obj);
89 markobj (d->connection);
90 markobj (d->canon_connection);
92 markobj (d->selected_frame);
93 markobj (d->frame_with_focus_real);
94 markobj (d->frame_with_focus_for_hooks);
95 markobj (d->frame_that_ought_to_have_focus);
96 markobj (d->device_class);
97 markobj (d->user_defined_tags);
98 markobj (d->pixel_to_glyph_cache.obj1);
99 markobj (d->pixel_to_glyph_cache.obj2);
101 markobj (d->color_instance_cache);
102 markobj (d->font_instance_cache);
104 markobj (d->charset_font_cache);
106 markobj (d->image_instance_cache);
110 markobj (d->devmeths->symbol);
111 MAYBE_DEVMETH (d, mark_device, (d, markobj));
114 return (d->frame_list);
118 print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
120 struct device *d = XDEVICE (obj);
124 error ("printing unreadable object #<device %s 0x%x>",
125 XSTRING_DATA (d->name), d->header.uid);
127 sprintf (buf, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" :
128 DEVICE_TYPE_NAME (d));
129 write_c_string (buf, printcharfun);
130 if (DEVICE_LIVE_P (d))
132 write_c_string (" on ", printcharfun);
133 print_internal (DEVICE_CONNECTION (d), printcharfun, 1);
135 sprintf (buf, " 0x%x>", d->header.uid);
136 write_c_string (buf, printcharfun);
139 DEFINE_LRECORD_IMPLEMENTATION ("device", device,
140 mark_device, print_device, 0, 0, 0,
144 valid_device_class_p (Lisp_Object class)
146 return !NILP (memq_no_quit (class, Vdevice_class_list));
149 DEFUN ("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0, /*
150 Given a DEVICE-CLASS, return t if it is valid.
151 Valid classes are 'color, 'grayscale, and 'mono.
155 return valid_device_class_p (device_class) ? Qt : Qnil;
158 DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /*
159 Return a list of valid device classes.
163 return Fcopy_sequence (Vdevice_class_list);
166 static struct device *
167 allocate_device (Lisp_Object console)
170 struct device *d = alloc_lcrecord_type (struct device, lrecord_device);
175 XSETDEVICE (device, d);
179 d->console = console;
180 d->connection = Qnil;
181 d->canon_connection = Qnil;
182 d->frame_list = Qnil;
183 d->selected_frame = Qnil;
184 d->frame_with_focus_real = Qnil;
185 d->frame_with_focus_for_hooks = Qnil;
186 d->frame_that_ought_to_have_focus = Qnil;
187 d->device_class = Qnil;
188 d->user_defined_tags = Qnil;
189 d->pixel_to_glyph_cache.obj1 = Qnil;
190 d->pixel_to_glyph_cache.obj2 = Qnil;
192 d->infd = d->outfd = -1;
194 /* #### is 20 reasonable? */
195 d->color_instance_cache =
196 make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL);
197 d->font_instance_cache =
198 make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL);
200 /* Note that the following table is bi-level. */
201 d->charset_font_cache =
202 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
205 Note that the image instance cache is actually bi-level.
206 See device.h. We use a low number here because most of the
207 time there aren't very many different masks that will be used.
209 d->image_instance_cache =
210 make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
217 decode_device (Lisp_Object device)
220 device = Fselected_device (Qnil);
221 /* quietly accept frames for the device arg */
222 else if (FRAMEP (device))
223 device = FRAME_DEVICE (decode_frame (device));
224 CHECK_LIVE_DEVICE (device);
225 return XDEVICE (device);
228 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /*
229 Given a device, frame, or window, return the associated device.
230 Return nil otherwise.
234 return DFW_DEVICE (obj);
238 DEFUN ("selected-device", Fselected_device, 0, 1, 0, /*
239 Return the device which is currently active.
240 If optional CONSOLE is non-nil, return the device that would be currently
241 active if CONSOLE were the selected console.
245 if (NILP (console) && NILP (Vselected_console))
246 return Qnil; /* happens early in temacs */
247 return CONSOLE_SELECTED_DEVICE (decode_console (console));
250 /* Called from selected_frame_1(), called from Fselect_window() */
252 select_device_1 (Lisp_Object device)
254 struct device *dev = XDEVICE (device);
255 Lisp_Object old_selected_device = Fselected_device (Qnil);
257 if (EQ (device, old_selected_device))
260 /* now select the device's console */
261 CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (dev))) = device;
262 select_console_1 (DEVICE_CONSOLE (dev));
265 DEFUN ("select-device", Fselect_device, 1, 1, 0, /*
266 Select the device DEVICE.
267 Subsequent editing commands apply to its console, selected frame,
269 The selection of DEVICE lasts until the next time the user does
270 something to select a different device, or until the next time this
275 CHECK_LIVE_DEVICE (device);
277 /* select the device's selected frame's selected window. This will call
278 selected_frame_1()->selected_device_1()->selected_console_1(). */
279 if (!NILP (DEVICE_SELECTED_FRAME (XDEVICE (device))))
280 Fselect_window (FRAME_SELECTED_WINDOW
281 (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device)))),
284 error ("Can't select a device with no frames");
289 set_device_selected_frame (struct device *d, Lisp_Object frame)
291 if (!NILP (frame) && !FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
292 set_console_last_nonminibuf_frame (XCONSOLE (DEVICE_CONSOLE (d)), frame);
293 d->selected_frame = frame;
296 DEFUN ("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /*
297 Set the selected frame of device object DEVICE to FRAME.
298 If DEVICE is nil, the selected device is used.
299 If DEVICE is the selected device, this makes FRAME the selected frame.
303 XSETDEVICE (device, decode_device (device));
304 CHECK_LIVE_FRAME (frame);
306 if (! EQ (device, FRAME_DEVICE (XFRAME (frame))))
307 error ("In `set-device-selected-frame', FRAME is not on DEVICE");
309 if (EQ (device, Fselected_device (Qnil)))
310 return Fselect_frame (frame);
312 set_device_selected_frame (XDEVICE (device), frame);
316 DEFUN ("devicep", Fdevicep, 1, 1, 0, /*
317 Return non-nil if OBJECT is a device.
321 return DEVICEP (object) ? Qt : Qnil;
324 DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /*
325 Return non-nil if OBJECT is a device that has not been deleted.
329 return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil;
332 DEFUN ("device-name", Fdevice_name, 0, 1, 0, /*
333 Return the name of the specified device.
334 DEVICE defaults to the selected device if omitted.
338 return DEVICE_NAME (decode_device (device));
341 DEFUN ("device-connection", Fdevice_connection, 0, 1, 0, /*
342 Return the connection of the specified device.
343 DEVICE defaults to the selected device if omitted.
347 return DEVICE_CONNECTION (decode_device (device));
350 DEFUN ("device-console", Fdevice_console, 0, 1, 0, /*
351 Return the console of the specified device.
352 DEVICE defaults to the selected device if omitted.
356 return DEVICE_CONSOLE (decode_device (device));
359 #ifdef HAVE_WINDOW_SYSTEM
362 init_global_resources (struct device *d)
364 init_global_faces (d);
365 #ifdef HAVE_SCROLLBARS
366 init_global_scrollbars (d);
369 init_global_toolbars (d);
376 init_device_resources (struct device *d)
378 init_device_faces (d);
379 #ifdef HAVE_SCROLLBARS
380 init_device_scrollbars (d);
383 init_device_toolbars (d);
388 semi_canonicalize_device_connection (struct console_methods *meths,
389 Lisp_Object name, Error_behavior errb)
391 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection,
396 canonicalize_device_connection (struct console_methods *meths,
397 Lisp_Object name, Error_behavior errb)
399 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection,
404 find_device_of_type (struct console_methods *meths, Lisp_Object canon)
406 Lisp_Object devcons, concons;
408 DEVICE_LOOP_NO_BREAK (devcons, concons)
410 Lisp_Object device = XCAR (devcons);
412 if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device)))
413 && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)),
421 DEFUN ("find-device", Ffind_device, 1, 2, 0, /*
422 Look for an existing device attached to connection CONNECTION.
423 Return the device if found; otherwise, return nil.
425 If TYPE is specified, only return devices of that type; otherwise,
426 return devices of any type. (It is possible, although unlikely,
427 that two devices of different types could have the same connection
428 name; in such a case, the first device found is returned.)
432 Lisp_Object canon = Qnil;
439 struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
440 canon = canonicalize_device_connection (conmeths, connection,
442 if (UNBOUNDP (canon))
443 RETURN_UNGCPRO (Qnil);
445 RETURN_UNGCPRO (find_device_of_type (conmeths, canon));
451 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
453 struct console_methods *conmeths =
454 Dynarr_at (the_console_type_entry_dynarr, i).meths;
455 canon = canonicalize_device_connection (conmeths, connection,
457 if (!UNBOUNDP (canon))
459 Lisp_Object device = find_device_of_type (conmeths, canon);
461 RETURN_UNGCPRO (device);
465 RETURN_UNGCPRO (Qnil);
469 DEFUN ("get-device", Fget_device, 1, 2, 0, /*
470 Look for an existing device attached to connection CONNECTION.
471 Return the device if found; otherwise, signal an error.
473 If TYPE is specified, only return devices of that type; otherwise,
474 return devices of any type. (It is possible, although unlikely,
475 that two devices of different types could have the same connection
476 name; in such a case, the first device found is returned.)
480 Lisp_Object device = Ffind_device (connection, type);
484 signal_simple_error ("No such device", connection);
486 signal_simple_error_2 ("No such device", type, connection);
492 delete_deviceless_console (Lisp_Object console)
494 if (NILP (XCONSOLE (console)->device_list))
495 Fdelete_console (console, Qnil);
499 DEFUN ("make-device", Fmake_device, 2, 3, 0, /*
500 Return a new device of type TYPE, attached to connection CONNECTION.
502 The valid values for CONNECTION are device-specific; however,
503 CONNECTION is generally a string. (Specifically, for X devices,
504 CONNECTION should be a display specification such as "foo:0", and
505 for TTY devices, CONNECTION should be the filename of a TTY device
506 file, such as "/dev/ttyp4", or nil to refer to XEmacs' standard
509 PROPS, if specified, should be a plist of properties controlling
512 If CONNECTION specifies an already-existing device connection, that
513 device is simply returned; no new device is created, and PROPS
516 (type, connection, props))
518 /* This function can GC */
521 Lisp_Object device = Qnil;
522 Lisp_Object console = Qnil;
523 Lisp_Object name = Qnil;
524 struct console_methods *conmeths;
525 int speccount = specpdl_depth();
527 struct gcpro gcpro1, gcpro2, gcpro3;
528 #ifdef HAVE_X_WINDOWS
529 /* #### icky-poo. If this is the first X device we are creating,
530 then retrieve the global face resources. We have to do it
531 here, at the same time as (or just before) the device face
532 resources are retrieved; specifically, it needs to be done
533 after the device has been created but before any frames have
534 been popped up or much anything else has been done. It's
535 possible for other devices to specify different global
536 resources (there's a property on each X server's root window
537 that holds some resources); tough luck for the moment.
539 This is a nasty violation of device independence, but
540 there's not a whole lot I can figure out to do about it.
541 The real problem is that the concept of resources is not
542 generalized away from X. Similar resource-related
543 device-independence violations occur in faces.el. */
544 int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx);
547 GCPRO3 (device, console, name);
549 conmeths = decode_console_type (type, ERROR_ME_NOT);
551 signal_simple_error ("Invalid device type", type);
553 device = Ffind_device (connection, type);
555 RETURN_UNGCPRO (device);
557 name = Fplist_get (props, Qname, Qnil);
560 Lisp_Object conconnect =
561 (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ?
562 CONTYPE_METH (conmeths, device_to_console_connection,
563 (connection, ERROR_ME)) :
565 console = create_console (name, type, conconnect, props);
568 record_unwind_protect(delete_deviceless_console, console);
570 con = XCONSOLE (console);
571 d = allocate_device (console);
572 XSETDEVICE (device, d);
574 d->devmeths = con->conmeths;
576 DEVICE_NAME (d) = name;
577 DEVICE_CONNECTION (d) =
578 semi_canonicalize_device_connection (conmeths, connection, ERROR_ME);
579 DEVICE_CANON_CONNECTION (d) =
580 canonicalize_device_connection (conmeths, connection, ERROR_ME);
582 MAYBE_DEVMETH (d, init_device, (d, props));
584 /* Do it this way so that the device list is in order of creation */
585 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil));
586 RESET_CHANGED_SET_FLAGS;
587 if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device)))
588 Vdefault_device = device;
590 init_device_sound (d);
591 #ifdef HAVE_X_WINDOWS
593 init_global_resources (d);
595 init_device_resources (d);
597 MAYBE_DEVMETH (d, finish_init_device, (d, props));
599 /* If this is the first device on the console, make it the selected one. */
600 if (NILP (CONSOLE_SELECTED_DEVICE (con)))
601 CONSOLE_SELECTED_DEVICE (con) = device;
603 /* #### the following should trap errors. */
604 setup_device_initial_specifier_tags (d);
607 unbind_to(speccount, Qnil);
611 /* find a device other than the selected one. Prefer non-stream
612 devices over stream devices. Maybe stay on the same console. */
615 find_other_device (Lisp_Object device, int on_same_console)
617 Lisp_Object devcons = Qnil, concons;
618 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device));
620 /* look for a non-stream device */
621 DEVICE_LOOP_NO_BREAK (devcons, concons)
623 Lisp_Object dev = XCAR (devcons);
624 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
626 if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) &&
627 !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
633 return XCAR (devcons);
635 /* OK, now look for a stream device */
636 DEVICE_LOOP_NO_BREAK (devcons, concons)
638 Lisp_Object dev = XCAR (devcons);
639 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
641 if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
646 return XCAR (devcons);
648 /* Sorry, there ain't none */
653 find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame,
658 VOID_TO_LISP (device, closure);
659 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
661 if (EQ (device, FRAME_DEVICE (XFRAME (frame))))
667 find_nonminibuffer_frame_not_on_device (Lisp_Object device)
669 return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate,
670 LISP_TO_VOID (device));
676 If FORCE is non-zero, allow deletion of the only frame.
678 If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if
679 deleting the last device on a console, just delete it,
680 instead of calling `delete-console'.
682 If FROM_IO_ERROR is non-zero, then the device is gone due
683 to an I/O error. This affects what happens if we exit
684 (we do an emergency exit instead of `save-buffers-kill-emacs'.)
688 delete_device_internal (struct device *d, int force,
689 int called_from_delete_console,
692 /* This function can GC */
697 /* OK to delete an already-deleted device. */
698 if (!DEVICE_LIVE_P (d))
701 XSETDEVICE (device, d);
704 c = XCONSOLE (DEVICE_CONSOLE (d));
706 if (!called_from_delete_console)
708 int delete_console = 0;
709 /* If we're deleting the only device on the console,
710 delete the console. */
711 if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1)
712 /* if we just created the device, it might not be listed,
714 && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c))))
716 /* Or if there aren't any nonminibuffer frames that would be
717 left, delete the console (this will make XEmacs exit). */
718 else if (NILP (find_nonminibuffer_frame_not_on_device (device)))
723 delete_console_internal (c, force, 0, from_io_error);
729 reset_one_device (d);
734 /* First delete all frames without their own minibuffers,
735 to avoid errors coming from attempting to delete a frame
736 that is a surrogate for another frame. */
737 DEVICE_FRAME_LOOP (frmcons, d)
739 struct frame *f = XFRAME (XCAR (frmcons));
740 /* delete_frame_internal() might do anything such as run hooks,
742 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
743 delete_frame_internal (f, 1, 1, from_io_error);
745 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
746 go ahead and delete anything */
753 /* #### This should probably be a device method but it is time for
754 19.14 to go out the door. */
755 #ifdef HAVE_X_WINDOWS
756 /* Next delete all frames which have the popup property to avoid
757 deleting a child after its parent. */
758 DEVICE_FRAME_LOOP (frmcons, d)
760 struct frame *f = XFRAME (XCAR (frmcons));
762 if (FRAME_LIVE_P (f))
764 Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil);
766 delete_frame_internal (f, 1, 1, from_io_error);
768 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
769 go ahead and delete anything */
776 #endif /* HAVE_X_WINDOWS */
778 DEVICE_FRAME_LOOP (frmcons, d)
780 struct frame *f = XFRAME (XCAR (frmcons));
781 /* delete_frame_internal() might do anything such as run hooks,
783 if (FRAME_LIVE_P (f))
784 delete_frame_internal (f, 1, 1, from_io_error);
786 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
787 go ahead and delete anything */
795 set_device_selected_frame (d, Qnil);
797 /* try to select another device */
799 if (EQ (device, Fselected_device (DEVICE_CONSOLE (d))))
801 Lisp_Object other_dev = find_other_device (device, 1);
802 if (!NILP (other_dev))
803 Fselect_device (other_dev);
806 if (EQ (device, Vdefault_device))
807 Vdefault_device = find_other_device (device, 0);
809 MAYBE_DEVMETH (d, delete_device, (d));
811 CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c));
812 RESET_CHANGED_SET_FLAGS;
813 d->devmeths = dead_console_methods;
817 /* delete a device as a result of an I/O error. Called from
818 an enqueued magic-eval event. */
821 io_error_delete_device (Lisp_Object device)
823 /* Note: it's the console that should get deleted, but
824 delete_device_internal() contains a hack that also deletes the
825 console when called from this function. */
826 delete_device_internal (XDEVICE (device), 1, 0, 1);
829 DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /*
830 Delete DEVICE, permanently eliminating it from use.
831 Normally, you cannot delete the last non-minibuffer-only frame (you must
832 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
833 second argument FORCE is non-nil, you can delete the last frame. (This
834 will automatically call `save-buffers-kill-emacs'.)
838 CHECK_DEVICE (device);
839 delete_device_internal (XDEVICE (device), !NILP (force), 0, 0);
843 DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /*
844 Return a list of all frames on DEVICE.
845 If DEVICE is nil, the selected device will be used.
849 return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device)));
852 DEFUN ("device-class", Fdevice_class, 0, 1, 0, /*
853 Return the class (color behavior) of DEVICE.
854 This will be one of 'color, 'grayscale, or 'mono.
858 return DEVICE_CLASS (decode_device (device));
861 DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /*
862 Set the class (color behavior) of DEVICE.
863 CLASS should be one of 'color, 'grayscale, or 'mono.
864 This is only allowed on device such as TTY devices, where the color
865 behavior cannot necessarily be determined automatically.
869 struct device *d = decode_device (device);
870 XSETDEVICE (device, d);
871 if (!DEVICE_TTY_P (d))
872 signal_simple_error ("Cannot change the class of this device", device);
873 if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale))
874 signal_simple_error ("Must be color, mono, or grayscale", class);
875 if (! EQ (DEVICE_CLASS (d), class))
878 DEVICE_CLASS (d) = class;
879 DEVICE_FRAME_LOOP (frmcons, d)
881 struct frame *f = XFRAME (XCAR (frmcons));
883 recompute_all_cached_specifiers_in_frame (f);
884 MARK_FRAME_FACES_CHANGED (f);
885 MARK_FRAME_GLYPHS_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"));