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 "scrollbar.h"
41 #include "specifier.h"
45 #include "syssignal.h"
47 /* Vdefault_device is the firstly-created non-stream device that's still
48 around. We don't really use it anywhere currently, but it might
49 be used for resourcing at some point. (Currently we use
50 Vdefault_x_device.) */
51 Lisp_Object Vdefault_device;
53 Lisp_Object Vcreate_device_hook, Vdelete_device_hook;
56 /* Qcolor defined in general.c */
57 Lisp_Object Qgrayscale, Qmono;
59 /* Device metrics symbols */
61 Qcolor_default, Qcolor_select, Qcolor_balloon, Qcolor_3d_face,
62 Qcolor_3d_light, Qcolor_3d_dark, Qcolor_menu, Qcolor_menu_highlight,
63 Qcolor_menu_button, Qcolor_menu_disabled, Qcolor_toolbar,
64 Qcolor_scrollbar, Qcolor_desktop, Qcolor_workspace, Qfont_default,
65 Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar,
66 Qsize_menu, Qsize_toolbar, Qsize_toolbar_button,
67 Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device,
68 Qsize_workspace, Qsize_device_mm, Qdevice_dpi, Qnum_bit_planes,
69 Qnum_color_cells, Qmouse_buttons, Qswap_buttons, Qshow_sounds,
70 Qslow_device, Qsecurity;
72 Lisp_Object Qdevicep, Qdevice_live_p;
73 Lisp_Object Qdelete_device;
74 Lisp_Object Qcreate_device_hook;
75 Lisp_Object Qdelete_device_hook;
77 Lisp_Object Vdevice_class_list;
81 mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object))
83 struct device *d = XDEVICE (obj);
85 ((markobj) (d->name));
86 ((markobj) (d->connection));
87 ((markobj) (d->canon_connection));
88 ((markobj) (d->console));
89 ((markobj) (d->_selected_frame));
90 ((markobj) (d->frame_with_focus_real));
91 ((markobj) (d->frame_with_focus_for_hooks));
92 ((markobj) (d->frame_that_ought_to_have_focus));
93 ((markobj) (d->device_class));
94 ((markobj) (d->user_defined_tags));
95 ((markobj) (d->pixel_to_glyph_cache.obj1));
96 ((markobj) (d->pixel_to_glyph_cache.obj2));
98 ((markobj) (d->color_instance_cache));
99 ((markobj) (d->font_instance_cache));
101 ((markobj) (d->charset_font_cache));
103 ((markobj) (d->image_instance_cache));
107 ((markobj) (d->devmeths->symbol));
108 MAYBE_DEVMETH (d, mark_device, (d, markobj));
111 return (d->frame_list);
115 print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
117 struct device *d = XDEVICE (obj);
121 error ("printing unreadable object #<device %s 0x%x>",
122 XSTRING_DATA (d->name), d->header.uid);
124 sprintf (buf, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" :
125 DEVICE_TYPE_NAME (d));
126 write_c_string (buf, printcharfun);
127 if (DEVICE_LIVE_P (d))
129 write_c_string (" on ", printcharfun);
130 print_internal (DEVICE_CONNECTION (d), printcharfun, 1);
132 sprintf (buf, " 0x%x>", d->header.uid);
133 write_c_string (buf, printcharfun);
136 DEFINE_LRECORD_IMPLEMENTATION ("device", device,
137 mark_device, print_device, 0, 0, 0,
141 valid_device_class_p (Lisp_Object class)
143 return !NILP (memq_no_quit (class, Vdevice_class_list));
146 DEFUN ("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0, /*
147 Given a DEVICE-CLASS, return t if it is valid.
148 Valid classes are 'color, 'grayscale, and 'mono.
152 return valid_device_class_p (device_class) ? Qt : Qnil;
155 DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /*
156 Return a list of valid device classes.
160 return Fcopy_sequence (Vdevice_class_list);
163 static struct device *
164 allocate_device (Lisp_Object console)
167 struct device *d = alloc_lcrecord_type (struct device, lrecord_device);
172 XSETDEVICE (device, d);
176 d->console = console;
177 d->connection = Qnil;
178 d->canon_connection = Qnil;
179 d->frame_list = Qnil;
180 d->_selected_frame = Qnil;
181 d->frame_with_focus_real = Qnil;
182 d->frame_with_focus_for_hooks = Qnil;
183 d->frame_that_ought_to_have_focus = Qnil;
184 d->device_class = Qnil;
185 d->user_defined_tags = Qnil;
186 d->pixel_to_glyph_cache.obj1 = Qnil;
187 d->pixel_to_glyph_cache.obj2 = Qnil;
189 d->infd = d->outfd = -1;
191 /* #### is 20 reasonable? */
192 d->color_instance_cache = make_lisp_hashtable (20, HASHTABLE_KEY_WEAK,
194 d->font_instance_cache = make_lisp_hashtable (20, HASHTABLE_KEY_WEAK,
197 /* Note that the following table is bi-level. */
198 d->charset_font_cache = make_lisp_hashtable (20, HASHTABLE_NONWEAK,
202 Note that the image instance cache is actually bi-level.
203 See device.h. We use a low number here because most of the
204 time there aren't very many diferent masks that will be used.
206 d->image_instance_cache = make_lisp_hashtable (5, HASHTABLE_NONWEAK,
214 decode_device (Lisp_Object device)
217 device = Fselected_device (Qnil);
218 /* quietly accept frames for the device arg */
220 device = FRAME_DEVICE (decode_frame (device));
221 CHECK_LIVE_DEVICE (device);
222 return XDEVICE (device);
225 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /*
226 Given a device, frame, or window, return the associated device.
227 Return nil otherwise.
231 return DFW_DEVICE (obj);
235 DEFUN ("selected-device", Fselected_device, 0, 1, 0, /*
236 Return the device which is currently active.
237 If optional CONSOLE is non-nil, return the device that would be currently
238 active if CONSOLE were the selected console.
242 if (NILP (console) && NILP (Vselected_console))
243 return Qnil; /* happens early in temacs */
244 return CONSOLE_SELECTED_DEVICE (decode_console (console));
247 /* Called from selected_frame_1(), called from Fselect_window() */
249 select_device_1 (Lisp_Object device)
251 struct device *dev = XDEVICE (device);
252 Lisp_Object old_selected_device = Fselected_device (Qnil);
254 if (EQ (device, old_selected_device))
257 /* now select the device's console */
258 CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (dev))) = device;
259 select_console_1 (DEVICE_CONSOLE (dev));
262 DEFUN ("select-device", Fselect_device, 1, 1, 0, /*
263 Select the device DEVICE.
264 Subsequent editing commands apply to its console, selected frame,
266 The selection of DEVICE lasts until the next time the user does
267 something to select a different device, or until the next time this
272 CHECK_LIVE_DEVICE (device);
274 /* select the device's selected frame's selected window. This will call
275 selected_frame_1()->selected_device_1()->selected_console_1(). */
276 if (!NILP (DEVICE_SELECTED_FRAME (XDEVICE (device))))
277 Fselect_window (FRAME_SELECTED_WINDOW
278 (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device)))),
281 error ("Can't select a device with no frames");
286 set_device_selected_frame (struct device *d, Lisp_Object frame)
288 if (!NILP (frame) && !FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
289 set_console_last_nonminibuf_frame (XCONSOLE (DEVICE_CONSOLE (d)), frame);
290 d->_selected_frame = frame;
293 DEFUN ("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /*
294 Set the selected frame of device object DEVICE to FRAME.
295 If DEVICE is nil, the selected device is used.
296 If DEVICE is the selected device, this makes FRAME the selected frame.
300 XSETDEVICE (device, decode_device (device));
301 CHECK_LIVE_FRAME (frame);
303 if (! EQ (device, FRAME_DEVICE (XFRAME (frame))))
304 error ("In `set-device-selected-frame', FRAME is not on DEVICE");
306 if (EQ (device, Fselected_device (Qnil)))
307 return Fselect_frame (frame);
309 set_device_selected_frame (XDEVICE (device), frame);
313 DEFUN ("devicep", Fdevicep, 1, 1, 0, /*
314 Return non-nil if OBJECT is a device.
318 return DEVICEP (object) ? Qt : Qnil;
321 DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /*
322 Return non-nil if OBJECT is a device that has not been deleted.
326 return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil;
329 DEFUN ("device-name", Fdevice_name, 0, 1, 0, /*
330 Return the name of the specified device.
331 DEVICE defaults to the selected device if omitted.
335 return DEVICE_NAME (decode_device (device));
338 DEFUN ("device-connection", Fdevice_connection, 0, 1, 0, /*
339 Return the connection of the specified device.
340 DEVICE defaults to the selected device if omitted.
344 return DEVICE_CONNECTION (decode_device (device));
347 DEFUN ("device-console", Fdevice_console, 0, 1, 0, /*
348 Return the console of the specified device.
349 DEVICE defaults to the selected device if omitted.
353 return DEVICE_CONSOLE (decode_device (device));
356 #ifdef HAVE_WINDOW_SYSTEM
359 init_global_resources (struct device *d)
361 init_global_faces (d);
362 #ifdef HAVE_SCROLLBARS
363 init_global_scrollbars (d);
366 init_global_toolbars (d);
373 init_device_resources (struct device *d)
375 init_device_faces (d);
376 #ifdef HAVE_SCROLLBARS
377 init_device_scrollbars (d);
380 init_device_toolbars (d);
385 semi_canonicalize_device_connection (struct console_methods *meths,
386 Lisp_Object name, Error_behavior errb)
388 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection,
393 canonicalize_device_connection (struct console_methods *meths,
394 Lisp_Object name, Error_behavior errb)
396 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection,
401 find_device_of_type (struct console_methods *meths, Lisp_Object canon)
403 Lisp_Object devcons, concons;
405 DEVICE_LOOP_NO_BREAK (devcons, concons)
407 Lisp_Object device = XCAR (devcons);
409 if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device)))
410 && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)),
418 DEFUN ("find-device", Ffind_device, 1, 2, 0, /*
419 Look for an existing device attached to connection CONNECTION.
420 Return the device if found; otherwise, return nil.
422 If TYPE is specified, only return devices of that type; otherwise,
423 return devices of any type. (It is possible, although unlikely,
424 that two devices of different types could have the same connection
425 name; in such a case, the first device found is returned.)
429 Lisp_Object canon = Qnil;
436 struct console_methods *conmeths = decode_console_type (type, ERROR_ME);
437 canon = canonicalize_device_connection (conmeths, connection,
439 if (UNBOUNDP (canon))
440 RETURN_UNGCPRO (Qnil);
442 RETURN_UNGCPRO (find_device_of_type (conmeths, canon));
448 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
450 struct console_methods *conmeths =
451 Dynarr_at (the_console_type_entry_dynarr, i).meths;
452 canon = canonicalize_device_connection (conmeths, connection,
454 if (!UNBOUNDP (canon))
456 Lisp_Object device = find_device_of_type (conmeths, canon);
458 RETURN_UNGCPRO (device);
462 RETURN_UNGCPRO (Qnil);
466 DEFUN ("get-device", Fget_device, 1, 2, 0, /*
467 Look for an existing device attached to connection CONNECTION.
468 Return the device if found; otherwise, signal an error.
470 If TYPE is specified, only return devices of that type; otherwise,
471 return devices of any type. (It is possible, although unlikely,
472 that two devices of different types could have the same connection
473 name; in such a case, the first device found is returned.)
477 Lisp_Object device = Ffind_device (connection, type);
481 signal_simple_error ("No such device", connection);
483 signal_simple_error_2 ("No such device", type, connection);
489 delete_deviceless_console (Lisp_Object console)
491 if (NILP (XCONSOLE (console)->device_list))
492 Fdelete_console (console, Qnil);
496 DEFUN ("make-device", Fmake_device, 2, 3, 0, /*
497 Return a new device of type TYPE, attached to connection CONNECTION.
499 The valid values for CONNECTION are device-specific; however,
500 CONNECTION is generally a string. (Specifically, for X devices,
501 CONNECTION should be a display specification such as "foo:0", and
502 for TTY devices, CONNECTION should be the filename of a TTY device
503 file, such as "/dev/ttyp4", or nil to refer to XEmacs' standard
506 PROPS, if specified, should be a plist of properties controlling
509 If CONNECTION specifies an already-existing device connection, that
510 device is simply returned; no new device is created, and PROPS
513 (type, connection, props))
515 /* This function can GC */
518 Lisp_Object device = Qnil;
519 Lisp_Object console = Qnil;
520 Lisp_Object name = Qnil;
521 struct console_methods *conmeths;
522 int speccount = specpdl_depth();
524 struct gcpro gcpro1, gcpro2, gcpro3;
525 #ifdef HAVE_X_WINDOWS
526 /* #### icky-poo. If this is the first X device we are creating,
527 then retrieve the global face resources. We have to do it
528 here, at the same time as (or just before) the device face
529 resources are retrieved; specifically, it needs to be done
530 after the device has been created but before any frames have
531 been popped up or much anything else has been done. It's
532 possible for other devices to specify different global
533 resources (there's a property on each X server's root window
534 that holds some resources); tough luck for the moment.
536 This is a nasty violation of device independence, but
537 there's not a whole lot I can figure out to do about it.
538 The real problem is that the concept of resources is not
539 generalized away from X. Similar resource-related
540 device-independence violations occur in faces.el. */
541 int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx);
544 GCPRO3 (device, console, name);
546 conmeths = decode_console_type (type, ERROR_ME_NOT);
548 signal_simple_error ("Invalid device type", type);
550 device = Ffind_device (connection, type);
552 RETURN_UNGCPRO (device);
554 name = Fplist_get (props, Qname, Qnil);
557 Lisp_Object conconnect =
558 (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ?
559 CONTYPE_METH (conmeths, device_to_console_connection,
560 (connection, ERROR_ME)) :
562 console = create_console (name, type, conconnect, props);
565 record_unwind_protect(delete_deviceless_console, console);
567 con = XCONSOLE (console);
568 d = allocate_device (console);
569 XSETDEVICE (device, d);
571 d->devmeths = con->conmeths;
573 DEVICE_NAME (d) = name;
574 DEVICE_CONNECTION (d) =
575 semi_canonicalize_device_connection (conmeths, connection, ERROR_ME);
576 DEVICE_CANON_CONNECTION (d) =
577 canonicalize_device_connection (conmeths, connection, ERROR_ME);
579 MAYBE_DEVMETH (d, init_device, (d, props));
581 /* Do it this way so that the device list is in order of creation */
582 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil));
583 RESET_CHANGED_SET_FLAGS;
584 if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device)))
585 Vdefault_device = device;
587 init_device_sound (d);
588 #ifdef HAVE_X_WINDOWS
590 init_global_resources (d);
592 init_device_resources (d);
594 MAYBE_DEVMETH (d, finish_init_device, (d, props));
596 /* If this is the first device on the console, make it the selected one. */
597 if (NILP (CONSOLE_SELECTED_DEVICE (con)))
598 CONSOLE_SELECTED_DEVICE (con) = device;
600 /* #### the following should trap errors. */
601 setup_device_initial_specifier_tags (d);
604 unbind_to(speccount, Qnil);
608 /* find a device other than the selected one. Prefer non-stream
609 devices over stream devices. Maybe stay on the same console. */
612 find_other_device (Lisp_Object device, int on_same_console)
614 Lisp_Object devcons = Qnil, concons;
615 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device));
617 /* look for a non-stream device */
618 DEVICE_LOOP_NO_BREAK (devcons, concons)
620 Lisp_Object dev = XCAR (devcons);
621 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
623 if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) &&
624 !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
630 return XCAR (devcons);
632 /* OK, now look for a stream device */
633 DEVICE_LOOP_NO_BREAK (devcons, concons)
635 Lisp_Object dev = XCAR (devcons);
636 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev))))
638 if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev))))
643 return XCAR (devcons);
645 /* Sorry, there ain't none */
650 find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame,
655 VOID_TO_LISP (device, closure);
656 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame)))
658 if (EQ (device, FRAME_DEVICE (XFRAME (frame))))
664 find_nonminibuffer_frame_not_on_device (Lisp_Object device)
666 return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate,
667 LISP_TO_VOID (device));
673 If FORCE is non-zero, allow deletion of the only frame.
675 If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if
676 deleting the last device on a console, just delete it,
677 instead of calling `delete-console'.
679 If FROM_IO_ERROR is non-zero, then the device is gone due
680 to an I/O error. This affects what happens if we exit
681 (we do an emergency exit instead of `save-buffers-kill-emacs'.)
685 delete_device_internal (struct device *d, int force,
686 int called_from_delete_console,
689 /* This function can GC */
694 /* OK to delete an already-deleted device. */
695 if (!DEVICE_LIVE_P (d))
698 XSETDEVICE (device, d);
701 c = XCONSOLE (DEVICE_CONSOLE (d));
703 if (!called_from_delete_console)
705 int delete_console = 0;
706 /* If we're deleting the only device on the console,
707 delete the console. */
708 if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1)
709 /* if we just created the device, it might not be listed,
711 && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c))))
713 /* Or if there aren't any nonminibuffer frames that would be
714 left, delete the console (this will make XEmacs exit). */
715 else if (NILP (find_nonminibuffer_frame_not_on_device (device)))
720 delete_console_internal (c, force, 0, from_io_error);
726 reset_one_device (d);
731 /* First delete all frames without their own minibuffers,
732 to avoid errors coming from attempting to delete a frame
733 that is a surrogate for another frame. */
734 DEVICE_FRAME_LOOP (frmcons, d)
736 struct frame *f = XFRAME (XCAR (frmcons));
737 /* delete_frame_internal() might do anything such as run hooks,
739 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f))
740 delete_frame_internal (f, 1, 1, from_io_error);
742 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
743 go ahead and delete anything */
750 /* #### This should probably be a device method but it is time for
751 19.14 to go out the door. */
752 #ifdef HAVE_X_WINDOWS
753 /* Next delete all frames which have the popup property to avoid
754 deleting a child after its parent. */
755 DEVICE_FRAME_LOOP (frmcons, d)
757 struct frame *f = XFRAME (XCAR (frmcons));
759 if (FRAME_LIVE_P (f))
761 Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil);
763 delete_frame_internal (f, 1, 1, from_io_error);
765 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
766 go ahead and delete anything */
773 #endif /* HAVE_X_WINDOWS */
775 DEVICE_FRAME_LOOP (frmcons, d)
777 struct frame *f = XFRAME (XCAR (frmcons));
778 /* delete_frame_internal() might do anything such as run hooks,
780 if (FRAME_LIVE_P (f))
781 delete_frame_internal (f, 1, 1, from_io_error);
783 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't
784 go ahead and delete anything */
792 set_device_selected_frame (d, Qnil);
794 /* try to select another device */
796 if (EQ (device, Fselected_device (DEVICE_CONSOLE (d))))
798 Lisp_Object other_dev = find_other_device (device, 1);
799 if (!NILP (other_dev))
800 Fselect_device (other_dev);
803 if (EQ (device, Vdefault_device))
804 Vdefault_device = find_other_device (device, 0);
806 MAYBE_DEVMETH (d, delete_device, (d));
808 CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c));
809 RESET_CHANGED_SET_FLAGS;
810 d->devmeths = dead_console_methods;
814 /* delete a device as a result of an I/O error. Called from
815 an enqueued magic-eval event. */
818 io_error_delete_device (Lisp_Object device)
820 delete_device_internal (XDEVICE (device), 1, 0, 1);
823 DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /*
824 Delete DEVICE, permanently eliminating it from use.
825 Normally, you cannot delete the last non-minibuffer-only frame (you must
826 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional
827 second argument FORCE is non-nil, you can delete the last frame. (This
828 will automatically call `save-buffers-kill-emacs'.)
832 CHECK_DEVICE (device);
833 delete_device_internal (XDEVICE (device), !NILP (force), 0, 0);
837 DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /*
838 Return a list of all frames on DEVICE.
839 If DEVICE is nil, the selected device will be used.
843 return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device)));
846 DEFUN ("device-class", Fdevice_class, 0, 1, 0, /*
847 Return the class (color behavior) of DEVICE.
848 This will be one of 'color, 'grayscale, or 'mono.
852 return DEVICE_CLASS (decode_device (device));
855 DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /*
856 Set the class (color behavior) of DEVICE.
857 CLASS should be one of 'color, 'grayscale, or 'mono.
858 This is only allowed on device such as TTY devices, where the color
859 behavior cannot necessarily be determined automatically.
863 struct device *d = decode_device (device);
864 XSETDEVICE (device, d);
865 if (!DEVICE_TTY_P (d))
866 signal_simple_error ("Cannot change the class of this device", device);
867 if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale))
868 signal_simple_error ("Must be color, mono, or grayscale", class);
869 if (! EQ (DEVICE_CLASS (d), class))
872 DEVICE_CLASS (d) = class;
873 DEVICE_FRAME_LOOP (frmcons, d)
875 struct frame *f = XFRAME (XCAR (frmcons));
877 recompute_all_cached_specifiers_in_frame (f);
878 MARK_FRAME_FACES_CHANGED (f);
879 MARK_FRAME_GLYPHS_CHANGED (f);
880 MARK_FRAME_TOOLBARS_CHANGED (f);
881 f->menubar_changed = 1;
887 DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /*
888 Set the output baud rate of DEVICE to RATE.
889 On most systems, changing this value will affect the amount of padding
890 and other strategic decisions made during redisplay.
896 DEVICE_BAUD_RATE (decode_device (device)) = XINT (rate);
901 DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /*
902 Return the output baud rate of DEVICE.
906 return make_int (DEVICE_BAUD_RATE (decode_device (device)));
909 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
910 Get a metric for DEVICE as provided by the system.
912 METRIC must be a symbol specifying requested metric. Note that the metrics
913 returned are these provided by the system internally, not read from resources,
914 so obtained from the most internal level.
916 If a metric is not provided by the system, then DEFAULT is returned.
918 When DEVICE is nil, selected device is assumed
920 Metrics, by group, are:
922 COLORS. Colors are returned as valid color instantiators. No other assumption
923 on the returned valie should be made (i.e. it can be a string on one system but
924 a color instance on another). For colors, returned value is a cons of
925 foreground and background colors. Note that if the system provides only one
926 color of the pair, the second one may be nil.
928 color-default Standard window text foreground and background.
929 color-select Selection highligh text and backgroun colors.
930 color-balloon Ballon popup text and background colors.
931 color-3d-face 3-D object (button, modeline) text and surface colors.
932 color-3d-light Fore and back colors for 3-D edges facing light source.
933 color-3d-dark Fore and back colors for 3-D edges facing away from
935 color-menu Text and background for menus
936 color-menu-highlight Selected menu item colors
937 color-menu-button Menu button colors
938 color-menu-disabled Unselectable menu item colors
939 color-toolbar Toolbar foreground and background colors
940 color-scrollbar Scrollbar foreground and background colors
941 color-desktop Desktop window colors
942 color-workspace Workspace window colors
944 FONTS. Fonts are returned as valid font instantiators. No other assumption on
945 the returned value should be made (i.e. it can be a string on one system but
946 font instance on another).
948 font-default Default fixed width font.
949 font-menubar Menubar font
950 font-dialog Dialog boxes font
952 GEOMETRY. These metrics are returned as conses of (X . Y). As with colors,
953 either car or cdr of the cons may be nil if the system does not provide one
954 of corresponding dimensions.
956 size-cursor Mouse cursor size.
957 size-scrollbar Scrollbars (WIDTH . HEIGHT)
958 size-menu Menubar height, as (nil . HEIGHT)
959 size-toolbar Toolbar width and height.
960 size-toolbar-button Toolbar button size.
961 size-toolbar-border Toolbar border width and height.
962 size-icon Icon dimensions.
963 size-icon-small Small icon dimensions.
964 size-device Device screen size in pixels.
965 size-workspace Workspace size in pixels. This can be less than the
966 above if window manager has decorations which
967 effectively shrink the area remaining for application
969 size-device-mm Device screen size in millimeters.
970 device-dpi Device resolution, in dots per inch.
971 num-bit-planes Integer, number of deivce bit planes.
972 num-color-cells Integer, number of device color cells.
974 FEATURES. This group reports various device features. If a feature is
975 present, integer 1 (one) is returned, if it is not present, then integer
976 0 (zero) is returned. If the system is unaware of the feature, then
979 mouse-buttons Integer, number of mouse buttons, or zero if no mouse.
980 swap-buttons Non-zero if left and right mouse buttons are swapped.
981 show-sounds User preference for visual over audible bell.
982 slow-device Device is slow, avoid animation.
983 security Non-zero if user environment is secure.
985 (device, metric, default_))
987 struct device *d = decode_device (device);
988 enum device_metrics m;
993 else if (EQ (metric, Q##met)) \
998 FROB (color_default);
1000 FROB (color_balloon);
1001 FROB (color_3d_face);
1002 FROB (color_3d_light);
1003 FROB (color_3d_dark);
1005 FROB (color_menu_highlight);
1006 FROB (color_menu_button);
1007 FROB (color_menu_disabled);
1008 FROB (color_toolbar);
1009 FROB (color_scrollbar);
1010 FROB (color_desktop);
1011 FROB (color_workspace);
1012 FROB (font_default);
1013 FROB (font_menubar);
1016 FROB (size_scrollbar);
1018 FROB (size_toolbar);
1019 FROB (size_toolbar_button);
1020 FROB (size_toolbar_border);
1022 FROB (size_icon_small);
1024 FROB (size_workspace);
1025 FROB (size_device_mm);
1027 FROB (num_bit_planes);
1028 FROB (num_color_cells);
1029 FROB (mouse_buttons);
1030 FROB (swap_buttons);
1035 signal_simple_error ("Invalid device metric symbol", metric);
1037 res = DEVMETH_OR_GIVEN (d, device_system_metrics, (d, m), Qunbound);
1038 return UNBOUNDP(res) ? default_ : res;
1043 DEFUN ("device-system-metrics", Fdevice_system_metrics, 0, 1, 0, /*
1044 Get a property list of device metric for DEVICE.
1046 See `device-system-metric' for the description of available metrics.
1047 DEVICE defaults to selected device when omitted.
1051 struct device *d = decode_device (device);
1052 Lisp_Object plist = Qnil, one_metric;
1055 if (!UNBOUNDP ((one_metric = \
1056 DEVMETH_OR_GIVEN (d, device_system_metrics, \
1057 (d, DM_##m), Qunbound)))) \
1058 plist = Fcons (Q##m, Fcons (one_metric, plist));
1060 FROB (color_default);
1061 FROB (color_select);
1062 FROB (color_balloon);
1063 FROB (color_3d_face);
1064 FROB (color_3d_light);
1065 FROB (color_3d_dark);
1067 FROB (color_menu_highlight);
1068 FROB (color_menu_button);
1069 FROB (color_menu_disabled);
1070 FROB (color_toolbar);
1071 FROB (color_scrollbar);
1072 FROB (color_desktop);
1073 FROB (color_workspace);
1074 FROB (font_default);
1075 FROB (font_menubar);
1078 FROB (size_scrollbar);
1080 FROB (size_toolbar);
1081 FROB (size_toolbar_button);
1082 FROB (size_toolbar_border);
1084 FROB (size_icon_small);
1086 FROB (size_workspace);
1087 FROB (size_device_mm);
1089 FROB (num_bit_planes);
1090 FROB (num_color_cells);
1091 FROB (mouse_buttons);
1092 FROB (swap_buttons);
1103 domain_device_type (Lisp_Object domain)
1105 /* This cannot GC */
1106 assert (WINDOWP (domain) || FRAMEP (domain)
1107 || DEVICEP (domain) || CONSOLEP (domain));
1109 if (WINDOWP (domain))
1111 if (!WINDOW_LIVE_P (XWINDOW (domain)))
1113 domain = WINDOW_FRAME (XWINDOW (domain));
1115 if (FRAMEP (domain))
1117 if (!FRAME_LIVE_P (XFRAME (domain)))
1119 domain = FRAME_DEVICE (XFRAME (domain));
1121 if (DEVICEP (domain))
1123 if (!DEVICE_LIVE_P (XDEVICE (domain)))
1125 domain = DEVICE_CONSOLE (XDEVICE (domain));
1127 return CONSOLE_TYPE (XCONSOLE (domain));
1131 * Determine whether window system bases window geometry on character
1133 * Return non-zero for pixel-based geometry, zero for character-based.
1136 window_system_pixelated_geometry (Lisp_Object domain)
1138 /* This cannot GC */
1139 Lisp_Object winsy = domain_device_type (domain);
1140 struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT);
1142 return (MAYBE_INT_CONTYPE_METH (meth, device_implementation_flags, ())
1143 & XDEVIMPF_PIXEL_GEOMETRY);
1146 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /*
1147 Return the device type symbol for a DOMAIN, e.g. 'x or 'tty.
1148 DOMAIN can be either a window, frame, device or console.
1152 if (!WINDOWP (domain) && !FRAMEP (domain)
1153 && !DEVICEP (domain) && !CONSOLEP (domain))
1155 ("Domain must be either a window, frame, device or console", domain);
1157 return domain_device_type (domain);
1161 handle_asynch_device_change (void)
1164 int old_asynch_device_change_pending = asynch_device_change_pending;
1165 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++)
1167 if (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1168 asynch_device_change_method)
1169 (Dynarr_at (the_console_type_entry_dynarr, i).meths->
1170 asynch_device_change_method) ();
1172 /* reset the flag to 0 unless another notification occurred while
1173 we were processing this one. Block SIGWINCH during this
1174 check to prevent a possible race condition. */
1176 EMACS_BLOCK_SIGNAL (SIGWINCH);
1178 if (old_asynch_device_change_pending == asynch_device_change_pending)
1179 asynch_device_change_pending = 0;
1181 EMACS_UNBLOCK_SIGNAL (SIGWINCH);
1186 call_critical_lisp_code (struct device *d, Lisp_Object function,
1189 int old_gc_currently_forbidden = gc_currently_forbidden;
1190 Lisp_Object old_inhibit_quit = Vinhibit_quit;
1192 /* There's no reason to bother doing specbinds here, because if
1193 initialize-*-faces signals an error, emacs is going to crash
1196 gc_currently_forbidden = 1;
1200 /* But it's useful to have an error handler; otherwise an infinite
1203 call1_with_handler (Qreally_early_error_handler, function, object);
1205 call0_with_handler (Qreally_early_error_handler, function);
1208 Vinhibit_quit = old_inhibit_quit;
1209 gc_currently_forbidden = old_gc_currently_forbidden;
1213 /************************************************************************/
1214 /* initialization */
1215 /************************************************************************/
1218 syms_of_device (void)
1220 DEFSUBR (Fvalid_device_class_p);
1221 DEFSUBR (Fdevice_class_list);
1223 DEFSUBR (Fdfw_device);
1224 DEFSUBR (Fselected_device);
1225 DEFSUBR (Fselect_device);
1226 DEFSUBR (Fset_device_selected_frame);
1228 DEFSUBR (Fdevice_live_p);
1229 DEFSUBR (Fdevice_name);
1230 DEFSUBR (Fdevice_connection);
1231 DEFSUBR (Fdevice_console);
1232 DEFSUBR (Ffind_device);
1233 DEFSUBR (Fget_device);
1234 DEFSUBR (Fmake_device);
1235 DEFSUBR (Fdelete_device);
1236 DEFSUBR (Fdevice_frame_list);
1237 DEFSUBR (Fdevice_class);
1238 DEFSUBR (Fset_device_class);
1239 DEFSUBR (Fdevice_system_metrics);
1240 DEFSUBR (Fdevice_system_metric);
1241 DEFSUBR (Fset_device_baud_rate);
1242 DEFSUBR (Fdevice_baud_rate);
1243 DEFSUBR (Fdomain_device_type);
1245 defsymbol (&Qdevicep, "devicep");
1246 defsymbol (&Qdevice_live_p, "device-live-p");
1247 defsymbol (&Qdelete_device, "delete-device");
1249 defsymbol (&Qcreate_device_hook, "create-device-hook");
1250 defsymbol (&Qdelete_device_hook, "delete-device-hook");
1252 /* Qcolor defined in general.c */
1253 defsymbol (&Qgrayscale, "grayscale");
1254 defsymbol (&Qmono, "mono");
1256 /* Device metrics symbols */
1257 defsymbol (&Qcolor_default, "color-default");
1258 defsymbol (&Qcolor_select, "color-select");
1259 defsymbol (&Qcolor_balloon, "color-balloon");
1260 defsymbol (&Qcolor_3d_face, "color-3d-face");
1261 defsymbol (&Qcolor_3d_light, "color-3d-light");
1262 defsymbol (&Qcolor_3d_dark, "color-3d-dark");
1263 defsymbol (&Qcolor_menu, "color-menu");
1264 defsymbol (&Qcolor_menu_highlight, "color-menu-highlight");
1265 defsymbol (&Qcolor_menu_button, "color-menu-button");
1266 defsymbol (&Qcolor_menu_disabled, "color-menu-disabled");
1267 defsymbol (&Qcolor_toolbar, "color-toolbar");
1268 defsymbol (&Qcolor_scrollbar, "color-scrollbar");
1269 defsymbol (&Qcolor_desktop, "color-desktop");
1270 defsymbol (&Qcolor_workspace, "color-workspace");
1271 defsymbol (&Qfont_default, "font-default");
1272 defsymbol (&Qfont_menubar, "font-menubar");
1273 defsymbol (&Qfont_dialog, "font-dialog");
1274 defsymbol (&Qsize_cursor, "size-cursor");
1275 defsymbol (&Qsize_scrollbar, "size-scrollbar");
1276 defsymbol (&Qsize_menu, "size-menu");
1277 defsymbol (&Qsize_toolbar, "size-toolbar");
1278 defsymbol (&Qsize_toolbar_button, "size-toolbar-button");
1279 defsymbol (&Qsize_toolbar_border, "size-toolbar-border");
1280 defsymbol (&Qsize_icon, "size-icon");
1281 defsymbol (&Qsize_icon_small, "size-icon-small");
1282 defsymbol (&Qsize_device, "size-device");
1283 defsymbol (&Qsize_workspace, "size-workspace");
1284 defsymbol (&Qsize_device_mm, "size-device-mm");
1285 defsymbol (&Qnum_bit_planes, "num-bit-planes");
1286 defsymbol (&Qnum_color_cells, "num-color-cells");
1287 defsymbol (&Qdevice_dpi, "device-dpi");
1288 defsymbol (&Qmouse_buttons, "mouse-buttons");
1289 defsymbol (&Qswap_buttons, "swap-buttons");
1290 defsymbol (&Qshow_sounds, "show-sounds");
1291 defsymbol (&Qslow_device, "slow-device");
1292 defsymbol (&Qsecurity, "security");
1296 vars_of_device (void)
1298 DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /*
1299 Function or functions to call when a device is created.
1300 One argument, the newly-created device.
1301 This is called after the first frame has been created, but before
1302 calling the `create-frame-hook'.
1303 Note that in general the device will not be selected.
1305 Vcreate_device_hook = Qnil;
1307 DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook /*
1308 Function or functions to call when a device is deleted.
1309 One argument, the to-be-deleted device.
1311 Vdelete_device_hook = Qnil;
1313 staticpro (&Vdefault_device);
1314 Vdefault_device = Qnil;
1316 asynch_device_change_pending = 0;
1318 Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono);
1319 staticpro (&Vdevice_class_list);
1321 /* Death to devices.el !!! */
1322 Fprovide(intern("devices"));