Mercurial > hg > xemacs-beta
annotate src/device.c @ 5124:623d57b7fbe8 ben-lisp-object
separate regular and disksave finalization, print method fixes.
Create separate disksave method and make the finalize method only be for
actual object finalization, not disksave finalization.
Fix places where 0 was given in place of a printer -- print methods are
mandatory, and internal objects formerly without a print method now must
explicitly specify internal_object_printer().
Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (very_old_free_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* buffer.c:
* bytecode.c:
* bytecode.c (Fcompiled_function_p):
* chartab.c:
* console-impl.h:
* console-impl.h (CONSOLE_TYPE_P):
* console.c:
* console.c (set_quit_events):
* data.c:
* data.c (Fmake_ephemeron):
* database.c:
* database.c (finalize_database):
* database.c (Fclose_database):
* device-msw.c:
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device.c:
* elhash.c:
* elhash.c (finalize_hash_table):
* eval.c:
* eval.c (bind_multiple_value_limits):
* event-stream.c:
* event-stream.c (finalize_command_builder):
* events.c:
* events.c (mark_event):
* extents.c:
* extents.c (finalize_extent_info):
* extents.c (uninit_buffer_extents):
* faces.c:
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.h:
* file-coding.h (struct coding_system_methods):
* file-coding.h (struct detector):
* floatfns.c:
* floatfns.c (extract_float):
* fns.c:
* fns.c (Fidentity):
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (finalize_fc_config):
* frame.c:
* glyphs.c:
* glyphs.c (finalize_image_instance):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* gui.c:
* gui.c (gui_error):
* keymap.c:
* lisp.h (struct Lisp_Symbol):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (finalize_lstream):
* lstream.c (disksave_lstream):
* marker.c:
* marker.c (finalize_marker):
* mule-charset.c (make_charset):
* number.c:
* objects.c:
* objects.c (finalize_color_instance):
* objects.c (finalize_font_instance):
* opaque.c:
* opaque.c (make_opaque_ptr):
* process-nt.c:
* process-nt.c (nt_finalize_process_data):
* process-nt.c (nt_deactivate_process):
* process.c:
* process.c (finalize_process):
* procimpl.h (struct process_methods):
* scrollbar.c:
* scrollbar.c (free_scrollbar_instance):
* specifier.c (finalize_specifier):
* symbols.c:
* toolbar.c:
* toolbar.c (Ftoolbar_button_p):
* tooltalk.c:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* window.c:
* window.c (finalize_window):
* window.c (mark_window_as_deleted):
Separate out regular and disksave finalization. Instead of a
FOR_DISKSAVE argument to the finalizer, create a separate object
method `disksaver'. Make `finalizer' have only one argument.
Go through and separate out all finalize methods into finalize
and disksave. Delete lots of thereby redundant disksave checking.
Delete places that signal an error if we attempt to disksave --
all of these objects are non-dumpable and we will get an error
from pdump anyway if we attempt to dump them. After this is done,
only one object remains that has a disksave method -- lstream.
Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT,
which is used for specifying either property methods or disksave
methods (or in the future, any other less-used methods).
Remove the for_disksave argument to finalize_process_data. Don't
provide a disksaver for processes because no one currently needs
it.
Clean up various places where objects didn't provide a print method.
It was made mandatory in previous changes, and all methods now
either provide their own print method or use internal_object_printer
or external_object_printer.
Change the definition of CONSOLE_LIVE_P to use the contype enum
rather than looking into the conmeths structure -- in some weird
situations with dead objects, the conmeths structure is NULL,
and printing such objects from debug_print() will crash if we try
to look into the conmeths structure.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 20 Jan 2010 07:05:57 -0600 |
| parents | d1247f3cc363 |
| children | b5df3737028a |
| rev | line source |
|---|---|
| 442 | 1 /* Generic device functions. |
| 428 | 2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. |
| 3 Copyright (C) 1994, 1995 Free Software Foundation, Inc. | |
| 853 | 4 Copyright (C) 1995, 1996, 2002 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 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 | |
| 11 later version. | |
| 12 | |
| 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 | |
| 16 for more details. | |
| 17 | |
| 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. */ | |
| 22 | |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 853 | 25 /* Written by Ben Wing, late 1995? |
| 26 Based on prototype by Chuck Thompson. | |
| 27 device-system-metric stuff added 1998? by Kirill Katsnelson. | |
| 28 */ | |
| 428 | 29 |
| 30 #include <config.h> | |
| 31 #include "lisp.h" | |
| 32 | |
| 33 #include "buffer.h" | |
| 34 #include "console.h" | |
| 872 | 35 #include "device-impl.h" |
| 428 | 36 #include "elhash.h" |
| 37 #include "events.h" | |
| 38 #include "faces.h" | |
| 872 | 39 #include "frame-impl.h" |
| 428 | 40 #include "keymap.h" |
| 872 | 41 #include "objects.h" |
| 428 | 42 #include "redisplay.h" |
| 43 #include "specifier.h" | |
| 44 #include "sysdep.h" | |
| 800 | 45 #include "toolbar.h" |
| 428 | 46 #include "window.h" |
| 47 | |
| 48 #ifdef HAVE_SCROLLBARS | |
| 49 #include "scrollbar.h" | |
| 50 #endif | |
| 51 | |
| 52 #include "syssignal.h" | |
| 53 | |
| 54 /* Vdefault_device is the firstly-created non-stream device that's still | |
| 55 around. We don't really use it anywhere currently, but it might | |
| 56 be used for resourcing at some point. (Currently we use | |
| 872 | 57 the default X device -- see Vdefault_device_plist.) */ |
| 428 | 58 Lisp_Object Vdefault_device; |
| 59 | |
| 60 Lisp_Object Vcreate_device_hook, Vdelete_device_hook; | |
| 61 | |
| 872 | 62 static Lisp_Object Vdefault_device_plist; |
| 63 | |
| 428 | 64 /* Device classes */ |
| 65 /* Qcolor defined in general.c */ | |
| 66 Lisp_Object Qgrayscale, Qmono; | |
| 67 | |
| 68 /* Device metrics symbols */ | |
| 69 Lisp_Object | |
| 70 Qcolor_default, Qcolor_select, Qcolor_balloon, Qcolor_3d_face, | |
| 71 Qcolor_3d_light, Qcolor_3d_dark, Qcolor_menu, Qcolor_menu_highlight, | |
| 72 Qcolor_menu_button, Qcolor_menu_disabled, Qcolor_toolbar, | |
| 73 Qcolor_scrollbar, Qcolor_desktop, Qcolor_workspace, Qfont_default, | |
| 74 Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar, | |
| 75 Qsize_menu, Qsize_toolbar, Qsize_toolbar_button, | |
| 76 Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device, | |
| 440 | 77 Qsize_workspace, Qoffset_workspace, Qsize_device_mm, Qdevice_dpi, |
| 1942 | 78 Qnum_bit_planes, Qnum_color_cells, Qnum_screens, Qmouse_buttons, |
| 79 Qsave_under, Qswap_buttons, Qshow_sounds, Qslow_device, Qsecurity, | |
| 80 Qbacking_store; | |
| 428 | 81 |
| 82 Lisp_Object Qdevicep, Qdevice_live_p; | |
| 83 Lisp_Object Qcreate_device_hook; | |
| 84 Lisp_Object Qdelete_device_hook; | |
| 85 Lisp_Object Vdevice_class_list; | |
| 86 | |
| 87 | |
| 934 | 88 |
| 3092 | 89 #ifndef NEW_GC |
| 1204 | 90 extern const struct sized_memory_description gtk_device_data_description; |
| 91 extern const struct sized_memory_description mswindows_device_data_description; | |
| 1346 | 92 extern const struct sized_memory_description msprinter_device_data_description; |
| 1204 | 93 extern const struct sized_memory_description x_device_data_description; |
| 3092 | 94 #endif /* not NEW_GC */ |
| 934 | 95 |
| 1204 | 96 static const struct memory_description device_data_description_1 []= { |
| 3092 | 97 #ifdef NEW_GC |
| 98 #ifdef HAVE_GTK | |
| 99 { XD_LISP_OBJECT, gtk_console }, | |
| 100 #endif | |
| 101 #ifdef HAVE_MS_WINDOWS | |
| 102 { XD_LISP_OBJECT, mswindows_console }, | |
| 103 { XD_LISP_OBJECT, msprinter_console }, | |
| 104 #endif | |
| 105 #ifdef HAVE_X_WINDOWS | |
| 106 { XD_LISP_OBJECT, x_console }, | |
| 107 #endif | |
| 108 #else /* not NEW_GC */ | |
| 934 | 109 #ifdef HAVE_GTK |
| 2551 | 110 { XD_BLOCK_PTR, gtk_console, 1, { >k_device_data_description} }, |
| 934 | 111 #endif |
| 1204 | 112 #ifdef HAVE_MS_WINDOWS |
| 2551 | 113 { XD_BLOCK_PTR, mswindows_console, 1, { &mswindows_device_data_description} }, |
| 114 { XD_BLOCK_PTR, msprinter_console, 1, { &msprinter_device_data_description} }, | |
| 1204 | 115 #endif |
| 934 | 116 #ifdef HAVE_X_WINDOWS |
| 2551 | 117 { XD_BLOCK_PTR, x_console, 1, { &x_device_data_description} }, |
| 934 | 118 #endif |
| 3092 | 119 #endif /* not NEW_GC */ |
| 934 | 120 { XD_END } |
| 121 }; | |
| 122 | |
| 1204 | 123 static const struct sized_memory_description device_data_description = { |
| 124 sizeof (void *), device_data_description_1 | |
| 934 | 125 }; |
| 126 | |
| 1204 | 127 static const struct memory_description device_description [] = { |
| 934 | 128 { XD_INT, offsetof (struct device, devtype) }, |
| 1204 | 129 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (struct device, x) }, |
| 130 #include "devslots.h" | |
| 131 | |
| 2367 | 132 { XD_BLOCK_PTR, offsetof (struct device, devmeths), 1, |
| 2551 | 133 { &console_methods_description } }, |
| 934 | 134 { XD_UNION, offsetof (struct device, device_data), |
| 2551 | 135 XD_INDIRECT (0, 0), { &device_data_description } }, |
| 934 | 136 { XD_END } |
| 137 }; | |
| 138 | |
| 428 | 139 static Lisp_Object |
| 140 mark_device (Lisp_Object obj) | |
| 141 { | |
| 142 struct device *d = XDEVICE (obj); | |
| 143 | |
| 1204 | 144 #define MARKED_SLOT(x) mark_object (d->x); |
| 617 | 145 #include "devslots.h" |
| 428 | 146 |
| 147 if (d->devmeths) | |
| 148 { | |
| 149 mark_object (d->devmeths->symbol); | |
| 150 MAYBE_DEVMETH (d, mark_device, (d)); | |
| 151 } | |
| 152 | |
| 153 return (d->frame_list); | |
| 154 } | |
| 155 | |
| 156 static void | |
| 2286 | 157 print_device (Lisp_Object obj, Lisp_Object printcharfun, |
| 158 int UNUSED (escapeflag)) | |
| 428 | 159 { |
| 160 struct device *d = XDEVICE (obj); | |
| 161 | |
| 162 if (print_readably) | |
| 563 | 163 printing_unreadable_object ("#<device %s 0x%x>", |
| 164 XSTRING_DATA (d->name), d->header.uid); | |
| 428 | 165 |
| 800 | 166 write_fmt_string (printcharfun, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" : |
| 167 DEVICE_TYPE_NAME (d)); | |
| 440 | 168 if (DEVICE_LIVE_P (d) && !NILP (DEVICE_CONNECTION (d))) |
| 800 | 169 write_fmt_string_lisp (printcharfun, " on %S", 1, DEVICE_CONNECTION (d)); |
| 170 write_fmt_string (printcharfun, " 0x%x>", d->header.uid); | |
| 428 | 171 } |
| 172 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
173 DEFINE_NODUMP_LISP_OBJECT ("device", device, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
174 mark_device, print_device, 0, 0, 0, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
175 device_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
176 struct device); |
| 428 | 177 |
| 178 int | |
| 1204 | 179 valid_device_class_p (Lisp_Object class_) |
| 428 | 180 { |
| 1204 | 181 return !NILP (memq_no_quit (class_, Vdevice_class_list)); |
| 428 | 182 } |
| 183 | |
| 184 DEFUN ("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0, /* | |
| 185 Given a DEVICE-CLASS, return t if it is valid. | |
| 3025 | 186 Valid classes are `color', `grayscale', and `mono'. |
| 428 | 187 */ |
| 188 (device_class)) | |
| 189 { | |
| 190 return valid_device_class_p (device_class) ? Qt : Qnil; | |
| 191 } | |
| 192 | |
| 193 DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /* | |
| 194 Return a list of valid device classes. | |
| 195 */ | |
| 196 ()) | |
| 197 { | |
| 198 return Fcopy_sequence (Vdevice_class_list); | |
| 199 } | |
| 200 | |
| 617 | 201 static void |
| 202 nuke_all_device_slots (struct device *d, Lisp_Object zap) | |
| 203 { | |
|
5120
d1247f3cc363
latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
204 ZERO_LISP_OBJECT (d); |
| 617 | 205 |
| 1204 | 206 #define MARKED_SLOT(x) d->x = zap; |
| 617 | 207 #include "devslots.h" |
| 208 } | |
| 209 | |
| 428 | 210 static struct device * |
| 211 allocate_device (Lisp_Object console) | |
| 212 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
213 Lisp_Object obj = ALLOC_LISP_OBJECT (device); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
214 struct device *d = XDEVICE (obj); |
| 428 | 215 struct gcpro gcpro1; |
| 216 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
217 GCPRO1 (obj); |
| 428 | 218 |
| 617 | 219 nuke_all_device_slots (d, Qnil); |
| 220 | |
| 428 | 221 d->console = console; |
| 222 d->infd = d->outfd = -1; | |
| 223 | |
| 224 /* #### is 20 reasonable? */ | |
| 225 d->color_instance_cache = | |
| 226 make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); | |
| 227 d->font_instance_cache = | |
| 228 make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); | |
| 229 #ifdef MULE | |
| 872 | 230 initialize_charset_font_caches (d); |
| 428 | 231 #endif |
| 232 /* | |
| 233 Note that the image instance cache is actually bi-level. | |
| 234 See device.h. We use a low number here because most of the | |
| 235 time there aren't very many different masks that will be used. | |
| 236 */ | |
| 237 d->image_instance_cache = | |
| 238 make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 239 | |
| 240 UNGCPRO; | |
| 241 return d; | |
| 242 } | |
| 243 | |
| 244 struct device * | |
| 245 decode_device (Lisp_Object device) | |
| 246 { | |
| 247 if (NILP (device)) | |
| 248 device = Fselected_device (Qnil); | |
| 249 /* quietly accept frames for the device arg */ | |
| 250 else if (FRAMEP (device)) | |
| 251 device = FRAME_DEVICE (decode_frame (device)); | |
| 252 CHECK_LIVE_DEVICE (device); | |
| 253 return XDEVICE (device); | |
| 254 } | |
| 255 | |
| 256 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /* | |
| 257 Given a device, frame, or window, return the associated device. | |
| 258 Return nil otherwise. | |
| 259 */ | |
| 444 | 260 (object)) |
| 428 | 261 { |
| 444 | 262 return DFW_DEVICE (object); |
| 428 | 263 } |
| 264 | |
| 872 | 265 Lisp_Object |
| 266 device_console (struct device *d) | |
| 267 { | |
| 268 return DEVICE_CONSOLE (d); | |
| 269 } | |
| 270 | |
| 271 int | |
| 272 device_live_p (struct device *d) | |
| 273 { | |
| 274 return DEVICE_LIVE_P (d); | |
| 275 } | |
| 276 | |
| 277 Lisp_Object | |
| 278 device_frame_list (struct device *d) | |
| 279 { | |
| 280 return DEVICE_FRAME_LIST (d); | |
| 281 } | |
| 282 | |
| 428 | 283 |
| 284 DEFUN ("selected-device", Fselected_device, 0, 1, 0, /* | |
| 285 Return the device which is currently active. | |
| 286 If optional CONSOLE is non-nil, return the device that would be currently | |
| 287 active if CONSOLE were the selected console. | |
| 288 */ | |
| 289 (console)) | |
| 290 { | |
| 291 if (NILP (console) && NILP (Vselected_console)) | |
| 292 return Qnil; /* happens early in temacs */ | |
| 293 return CONSOLE_SELECTED_DEVICE (decode_console (console)); | |
| 294 } | |
| 295 | |
| 296 /* Called from selected_frame_1(), called from Fselect_window() */ | |
| 297 void | |
| 298 select_device_1 (Lisp_Object device) | |
| 299 { | |
| 300 struct device *dev = XDEVICE (device); | |
| 301 Lisp_Object old_selected_device = Fselected_device (Qnil); | |
| 302 | |
| 303 if (EQ (device, old_selected_device)) | |
| 304 return; | |
| 305 | |
| 306 /* now select the device's console */ | |
| 307 CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (dev))) = device; | |
| 308 select_console_1 (DEVICE_CONSOLE (dev)); | |
| 309 } | |
| 310 | |
| 311 DEFUN ("select-device", Fselect_device, 1, 1, 0, /* | |
| 312 Select the device DEVICE. | |
| 313 Subsequent editing commands apply to its console, selected frame, | |
| 314 and selected window. | |
| 315 The selection of DEVICE lasts until the next time the user does | |
| 316 something to select a different device, or until the next time this | |
| 317 function is called. | |
| 318 */ | |
| 319 (device)) | |
| 320 { | |
| 321 CHECK_LIVE_DEVICE (device); | |
| 322 | |
| 323 /* select the device's selected frame's selected window. This will call | |
| 324 selected_frame_1()->selected_device_1()->selected_console_1(). */ | |
| 325 if (!NILP (DEVICE_SELECTED_FRAME (XDEVICE (device)))) | |
| 326 Fselect_window (FRAME_SELECTED_WINDOW | |
| 327 (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device)))), | |
| 328 Qnil); | |
| 329 else | |
| 563 | 330 invalid_operation ("Can't select a device with no frames", Qunbound); |
| 428 | 331 return Qnil; |
| 332 } | |
| 333 | |
| 334 void | |
| 335 set_device_selected_frame (struct device *d, Lisp_Object frame) | |
| 336 { | |
| 337 if (!NILP (frame) && !FRAME_MINIBUF_ONLY_P (XFRAME (frame))) | |
| 338 set_console_last_nonminibuf_frame (XCONSOLE (DEVICE_CONSOLE (d)), frame); | |
| 339 d->selected_frame = frame; | |
| 340 } | |
| 341 | |
| 342 DEFUN ("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /* | |
| 343 Set the selected frame of device object DEVICE to FRAME. | |
| 344 If DEVICE is nil, the selected device is used. | |
| 345 If DEVICE is the selected device, this makes FRAME the selected frame. | |
| 346 */ | |
| 347 (device, frame)) | |
| 348 { | |
| 793 | 349 device = wrap_device (decode_device (device)); |
| 428 | 350 CHECK_LIVE_FRAME (frame); |
| 351 | |
| 352 if (! EQ (device, FRAME_DEVICE (XFRAME (frame)))) | |
| 617 | 353 invalid_argument ("In `set-device-selected-frame', FRAME is not on DEVICE", |
| 354 Qunbound); | |
| 428 | 355 |
| 356 if (EQ (device, Fselected_device (Qnil))) | |
| 357 return Fselect_frame (frame); | |
| 358 | |
| 359 set_device_selected_frame (XDEVICE (device), frame); | |
| 360 return frame; | |
| 361 } | |
| 362 | |
| 363 DEFUN ("devicep", Fdevicep, 1, 1, 0, /* | |
| 364 Return non-nil if OBJECT is a device. | |
| 365 */ | |
| 366 (object)) | |
| 367 { | |
| 368 return DEVICEP (object) ? Qt : Qnil; | |
| 369 } | |
| 370 | |
| 371 DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /* | |
| 372 Return non-nil if OBJECT is a device that has not been deleted. | |
| 373 */ | |
| 374 (object)) | |
| 375 { | |
| 376 return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil; | |
| 377 } | |
| 378 | |
| 379 DEFUN ("device-name", Fdevice_name, 0, 1, 0, /* | |
| 380 Return the name of the specified device. | |
| 381 DEVICE defaults to the selected device if omitted. | |
| 382 */ | |
| 383 (device)) | |
| 384 { | |
| 385 return DEVICE_NAME (decode_device (device)); | |
| 386 } | |
| 387 | |
| 388 DEFUN ("device-connection", Fdevice_connection, 0, 1, 0, /* | |
| 389 Return the connection of the specified device. | |
| 390 DEVICE defaults to the selected device if omitted. | |
| 391 */ | |
| 392 (device)) | |
| 393 { | |
| 394 return DEVICE_CONNECTION (decode_device (device)); | |
| 395 } | |
| 396 | |
| 397 DEFUN ("device-console", Fdevice_console, 0, 1, 0, /* | |
| 398 Return the console of the specified device. | |
| 399 DEVICE defaults to the selected device if omitted. | |
| 400 */ | |
| 401 (device)) | |
| 402 { | |
| 403 return DEVICE_CONSOLE (decode_device (device)); | |
| 404 } | |
| 405 | |
| 406 static void | |
| 407 init_global_resources (struct device *d) | |
| 408 { | |
| 409 init_global_faces (d); | |
| 410 #ifdef HAVE_SCROLLBARS | |
| 411 init_global_scrollbars (d); | |
| 412 #endif | |
| 413 #ifdef HAVE_TOOLBARS | |
| 414 init_global_toolbars (d); | |
| 415 #endif | |
| 416 } | |
| 417 | |
| 418 static void | |
| 419 init_device_resources (struct device *d) | |
| 420 { | |
| 421 init_device_faces (d); | |
| 422 #ifdef HAVE_SCROLLBARS | |
| 423 init_device_scrollbars (d); | |
| 424 #endif | |
| 425 #ifdef HAVE_TOOLBARS | |
| 426 init_device_toolbars (d); | |
| 427 #endif | |
| 428 } | |
| 429 | |
| 872 | 430 DEFUN ("default-device", Fdefault_device, 0, 1, 0, /* |
| 431 Return the default device of type TYPE. | |
| 432 This is generally the first-created device of that TYPE that still exists. | |
| 433 It is used for resourcing and certain other things. On MS Windows, it | |
| 434 is not very useful because there is generally only one device. | |
| 435 If TYPE is omitted, it is derived from the selected device. | |
| 436 If there is no default device of TYPE, nil is returned. | |
| 437 */ | |
| 438 (type)) | |
| 439 { | |
| 440 if (NILP (type)) | |
| 441 type = XDEVICE_TYPE (Fselected_device (Qnil)); | |
| 442 else | |
| 443 /* For errors */ | |
| 444 decode_console_type (type, ERROR_ME); | |
| 445 | |
| 446 return Fplist_get (Vdefault_device_plist, type, Qnil); | |
| 447 } | |
| 448 | |
| 449 /* Return the default device for a device type. */ | |
| 450 Lisp_Object | |
| 451 get_default_device (Lisp_Object type) | |
| 452 { | |
| 453 return Fplist_get (Vdefault_device_plist, type, Qnil); | |
| 454 } | |
| 455 | |
| 456 /* Set the default device for a device type. */ | |
| 457 void | |
| 458 set_default_device (Lisp_Object type, Lisp_Object device) | |
| 459 { | |
| 460 Vdefault_device_plist = Fplist_put (Vdefault_device_plist, type, device); | |
| 461 } | |
| 462 | |
| 463 void | |
| 464 clear_default_devices (void) | |
| 465 { | |
| 466 Vdefault_device_plist = Qnil; | |
| 467 } | |
| 468 | |
| 428 | 469 static Lisp_Object |
| 470 semi_canonicalize_device_connection (struct console_methods *meths, | |
| 578 | 471 Lisp_Object name, Error_Behavior errb) |
| 428 | 472 { |
| 440 | 473 if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_device_connection)) |
| 474 return CONTYPE_METH (meths, semi_canonicalize_device_connection, | |
| 475 (name, errb)); | |
| 476 else | |
| 477 return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection, | |
| 478 (name, errb), name); | |
| 428 | 479 } |
| 480 | |
| 481 static Lisp_Object | |
| 482 canonicalize_device_connection (struct console_methods *meths, | |
| 578 | 483 Lisp_Object name, Error_Behavior errb) |
| 428 | 484 { |
| 440 | 485 if (HAS_CONTYPE_METH_P (meths, canonicalize_device_connection)) |
| 486 return CONTYPE_METH (meths, canonicalize_device_connection, | |
| 487 (name, errb)); | |
| 488 else | |
| 489 return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection, | |
| 490 (name, errb), name); | |
| 428 | 491 } |
| 492 | |
| 493 static Lisp_Object | |
| 494 find_device_of_type (struct console_methods *meths, Lisp_Object canon) | |
| 495 { | |
| 496 Lisp_Object devcons, concons; | |
| 497 | |
| 498 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 499 { | |
| 500 Lisp_Object device = XCAR (devcons); | |
| 501 | |
| 502 if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device))) | |
| 503 && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)), | |
| 504 canon, 0)) | |
| 505 return device; | |
| 506 } | |
| 507 | |
| 508 return Qnil; | |
| 509 } | |
| 510 | |
| 511 DEFUN ("find-device", Ffind_device, 1, 2, 0, /* | |
| 512 Look for an existing device attached to connection CONNECTION. | |
| 513 Return the device if found; otherwise, return nil. | |
| 514 | |
| 515 If TYPE is specified, only return devices of that type; otherwise, | |
| 516 return devices of any type. (It is possible, although unlikely, | |
| 517 that two devices of different types could have the same connection | |
| 518 name; in such a case, the first device found is returned.) | |
| 519 */ | |
| 520 (connection, type)) | |
| 521 { | |
| 522 Lisp_Object canon = Qnil; | |
| 523 struct gcpro gcpro1; | |
| 524 | |
| 525 GCPRO1 (canon); | |
| 526 | |
| 527 if (!NILP (type)) | |
| 528 { | |
| 529 struct console_methods *conmeths = decode_console_type (type, ERROR_ME); | |
| 530 canon = canonicalize_device_connection (conmeths, connection, | |
| 531 ERROR_ME_NOT); | |
| 532 if (UNBOUNDP (canon)) | |
| 533 RETURN_UNGCPRO (Qnil); | |
| 534 | |
| 535 RETURN_UNGCPRO (find_device_of_type (conmeths, canon)); | |
| 536 } | |
| 537 else | |
| 538 { | |
| 539 int i; | |
| 540 | |
| 541 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) | |
| 542 { | |
| 543 struct console_methods *conmeths = | |
| 544 Dynarr_at (the_console_type_entry_dynarr, i).meths; | |
| 545 canon = canonicalize_device_connection (conmeths, connection, | |
| 546 ERROR_ME_NOT); | |
| 547 if (!UNBOUNDP (canon)) | |
| 548 { | |
| 549 Lisp_Object device = find_device_of_type (conmeths, canon); | |
| 550 if (!NILP (device)) | |
| 551 RETURN_UNGCPRO (device); | |
| 552 } | |
| 553 } | |
| 554 | |
| 555 RETURN_UNGCPRO (Qnil); | |
| 556 } | |
| 557 } | |
| 558 | |
| 559 DEFUN ("get-device", Fget_device, 1, 2, 0, /* | |
| 560 Look for an existing device attached to connection CONNECTION. | |
| 561 Return the device if found; otherwise, signal an error. | |
| 562 | |
| 563 If TYPE is specified, only return devices of that type; otherwise, | |
| 564 return devices of any type. (It is possible, although unlikely, | |
| 565 that two devices of different types could have the same connection | |
| 566 name; in such a case, the first device found is returned.) | |
| 567 */ | |
| 568 (connection, type)) | |
| 569 { | |
| 570 Lisp_Object device = Ffind_device (connection, type); | |
| 571 if (NILP (device)) | |
| 572 { | |
| 573 if (NILP (type)) | |
| 563 | 574 invalid_argument ("No such device", connection); |
| 428 | 575 else |
| 563 | 576 invalid_argument_2 ("No such device", type, connection); |
| 428 | 577 } |
| 578 return device; | |
| 579 } | |
| 580 | |
| 581 static Lisp_Object | |
| 582 delete_deviceless_console (Lisp_Object console) | |
| 583 { | |
| 584 if (NILP (XCONSOLE (console)->device_list)) | |
| 585 Fdelete_console (console, Qnil); | |
| 586 return Qnil; | |
| 587 } | |
| 588 | |
| 589 DEFUN ("make-device", Fmake_device, 2, 3, 0, /* | |
| 590 Return a new device of type TYPE, attached to connection CONNECTION. | |
| 591 | |
| 592 The valid values for CONNECTION are device-specific; however, | |
| 593 CONNECTION is generally a string. (Specifically, for X devices, | |
| 594 CONNECTION should be a display specification such as "foo:0", and | |
| 595 for TTY devices, CONNECTION should be the filename of a TTY device | |
| 596 file, such as "/dev/ttyp4", or nil to refer to XEmacs' standard | |
| 597 input/output.) | |
| 598 | |
| 599 PROPS, if specified, should be a plist of properties controlling | |
| 600 device creation. | |
| 601 | |
| 602 If CONNECTION specifies an already-existing device connection, that | |
| 603 device is simply returned; no new device is created, and PROPS | |
| 604 have no effect. | |
| 605 */ | |
| 606 (type, connection, props)) | |
| 607 { | |
| 608 /* This function can GC */ | |
| 609 struct device *d; | |
| 610 struct console *con; | |
| 611 Lisp_Object device = Qnil; | |
| 612 Lisp_Object console = Qnil; | |
| 613 Lisp_Object name = Qnil; | |
| 614 struct console_methods *conmeths; | |
| 1204 | 615 int speccount = specpdl_depth (); |
| 428 | 616 |
| 617 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 872 | 618 /* If this is the first device we are creating of a particular type |
| 619 (e.g. X), then retrieve the global face resources. We have to do it | |
| 620 here, at the same time as (or just before) the device face resources | |
| 621 are retrieved; specifically, it needs to be done after the device has | |
| 622 been created but before any frames have been popped up or much | |
| 623 anything else has been done. It's possible for other devices to | |
| 624 specify different global resources (there's a property on each X | |
| 625 server's root window that holds some resources); tough luck for the | |
| 626 moment. */ | |
| 627 int first = NILP (get_default_device (type)); | |
| 428 | 628 |
| 629 GCPRO3 (device, console, name); | |
| 630 | |
| 631 conmeths = decode_console_type (type, ERROR_ME_NOT); | |
| 632 if (!conmeths) | |
| 563 | 633 invalid_constant ("Invalid device type", type); |
| 428 | 634 |
| 635 device = Ffind_device (connection, type); | |
| 636 if (!NILP (device)) | |
| 637 RETURN_UNGCPRO (device); | |
| 638 | |
| 639 name = Fplist_get (props, Qname, Qnil); | |
| 640 | |
| 641 { | |
| 642 Lisp_Object conconnect = | |
| 643 (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ? | |
| 644 CONTYPE_METH (conmeths, device_to_console_connection, | |
| 645 (connection, ERROR_ME)) : | |
| 646 connection; | |
| 647 console = create_console (name, type, conconnect, props); | |
| 648 } | |
| 649 | |
| 872 | 650 record_unwind_protect (delete_deviceless_console, console); |
| 428 | 651 |
| 652 con = XCONSOLE (console); | |
| 653 d = allocate_device (console); | |
| 793 | 654 device = wrap_device (d); |
| 428 | 655 |
| 656 d->devmeths = con->conmeths; | |
| 934 | 657 d->devtype = get_console_variant (type); |
| 428 | 658 |
| 659 DEVICE_NAME (d) = name; | |
| 660 DEVICE_CONNECTION (d) = | |
| 661 semi_canonicalize_device_connection (conmeths, connection, ERROR_ME); | |
| 662 DEVICE_CANON_CONNECTION (d) = | |
| 663 canonicalize_device_connection (conmeths, connection, ERROR_ME); | |
| 664 | |
| 665 MAYBE_DEVMETH (d, init_device, (d, props)); | |
| 666 | |
| 667 /* Do it this way so that the device list is in order of creation */ | |
| 668 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil)); | |
| 872 | 669 |
| 670 if (NILP (get_default_device (type))) | |
| 671 set_default_device (type, device); | |
| 672 | |
| 853 | 673 note_object_created (device); |
| 674 | |
| 428 | 675 RESET_CHANGED_SET_FLAGS; |
| 676 if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device))) | |
| 677 Vdefault_device = device; | |
| 678 | |
| 679 init_device_sound (d); | |
| 680 | |
| 681 /* If this is the first device on the console, make it the selected one. */ | |
| 682 if (NILP (CONSOLE_SELECTED_DEVICE (con))) | |
| 683 CONSOLE_SELECTED_DEVICE (con) = device; | |
| 684 | |
| 872 | 685 /* Needed before initialization of resources because they may do things |
| 686 with the tags, esp. the face code. For example, | |
| 687 init-other-random-faces calls face-property-instance, and the | |
| 688 specifier code checks inst-pairs by seeing if the device matches the | |
| 689 tag; this fails for tags such as `default', if we haven't set up the | |
| 690 tags yet. */ | |
| 428 | 691 setup_device_initial_specifier_tags (d); |
| 692 | |
| 872 | 693 if (!EQ (type, Qstream)) |
| 694 { | |
| 695 if (first) | |
| 696 init_global_resources (d); | |
| 697 init_device_resources (d); | |
| 698 } | |
| 699 | |
| 700 MAYBE_DEVMETH (d, finish_init_device, (d, props)); | |
| 701 | |
| 428 | 702 UNGCPRO; |
| 771 | 703 unbind_to (speccount); |
| 428 | 704 return device; |
| 705 } | |
| 706 | |
| 707 /* find a device other than the selected one. Prefer non-stream | |
| 708 devices over stream devices. Maybe stay on the same console. */ | |
| 709 | |
| 710 static Lisp_Object | |
| 711 find_other_device (Lisp_Object device, int on_same_console) | |
| 712 { | |
| 713 Lisp_Object devcons = Qnil, concons; | |
| 714 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device)); | |
| 715 | |
| 716 /* look for a non-stream device */ | |
| 717 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 718 { | |
| 719 Lisp_Object dev = XCAR (devcons); | |
| 720 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev)))) | |
| 721 continue; | |
| 722 if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) && | |
| 723 !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev)))) | |
| 724 goto double_break_1; | |
| 725 } | |
| 726 | |
| 727 double_break_1: | |
| 728 if (!NILP (devcons)) | |
| 729 return XCAR (devcons); | |
| 730 | |
| 731 /* OK, now look for a stream device */ | |
| 732 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 733 { | |
| 734 Lisp_Object dev = XCAR (devcons); | |
| 735 if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev)))) | |
| 736 continue; | |
| 737 if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev)))) | |
| 738 goto double_break_2; | |
| 739 } | |
| 740 double_break_2: | |
| 741 if (!NILP (devcons)) | |
| 742 return XCAR (devcons); | |
| 743 | |
| 744 /* Sorry, there ain't none */ | |
| 745 return Qnil; | |
| 746 } | |
| 747 | |
| 748 static int | |
| 749 find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame, | |
| 750 void *closure) | |
| 751 { | |
| 752 Lisp_Object device; | |
| 753 | |
| 826 | 754 device = VOID_TO_LISP (closure); |
| 428 | 755 if (FRAME_MINIBUF_ONLY_P (XFRAME (frame))) |
| 756 return 0; | |
| 757 if (EQ (device, FRAME_DEVICE (XFRAME (frame)))) | |
| 758 return 0; | |
| 759 return 1; | |
| 760 } | |
| 761 | |
| 762 Lisp_Object | |
| 763 find_nonminibuffer_frame_not_on_device (Lisp_Object device) | |
| 764 { | |
| 765 return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate, | |
| 766 LISP_TO_VOID (device)); | |
| 767 } | |
| 768 | |
| 769 | |
| 770 /* Delete device D. | |
| 771 | |
| 772 If FORCE is non-zero, allow deletion of the only frame. | |
| 773 | |
| 774 If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if | |
| 775 deleting the last device on a console, just delete it, | |
| 776 instead of calling `delete-console'. | |
| 777 | |
| 778 If FROM_IO_ERROR is non-zero, then the device is gone due | |
| 779 to an I/O error. This affects what happens if we exit | |
| 780 (we do an emergency exit instead of `save-buffers-kill-emacs'.) | |
| 781 */ | |
| 782 | |
| 783 void | |
| 784 delete_device_internal (struct device *d, int force, | |
| 785 int called_from_delete_console, | |
| 786 int from_io_error) | |
| 787 { | |
| 788 /* This function can GC */ | |
| 789 struct console *c; | |
| 790 Lisp_Object device; | |
| 791 struct gcpro gcpro1; | |
| 792 | |
| 793 /* OK to delete an already-deleted device. */ | |
| 794 if (!DEVICE_LIVE_P (d)) | |
| 795 return; | |
| 796 | |
| 793 | 797 device = wrap_device (d); |
| 853 | 798 |
| 799 if (!force) | |
| 800 check_allowed_operation (OPERATION_DELETE_OBJECT, device, Qnil); | |
| 801 | |
| 428 | 802 GCPRO1 (device); |
| 803 | |
| 804 c = XCONSOLE (DEVICE_CONSOLE (d)); | |
| 805 | |
| 806 if (!called_from_delete_console) | |
| 807 { | |
| 808 int delete_console = 0; | |
| 809 /* If we're deleting the only device on the console, | |
| 810 delete the console. */ | |
| 811 if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1) | |
| 812 /* if we just created the device, it might not be listed, | |
| 813 or something ... */ | |
| 814 && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c)))) | |
| 815 delete_console = 1; | |
| 816 /* Or if there aren't any nonminibuffer frames that would be | |
| 817 left, delete the console (this will make XEmacs exit). */ | |
| 818 else if (NILP (find_nonminibuffer_frame_not_on_device (device))) | |
| 819 delete_console = 1; | |
| 820 | |
| 821 if (delete_console) | |
| 822 { | |
| 823 delete_console_internal (c, force, 0, from_io_error); | |
| 824 UNGCPRO; | |
| 825 return; | |
| 826 } | |
| 827 } | |
| 828 | |
| 829 reset_one_device (d); | |
| 830 | |
| 831 { | |
| 832 Lisp_Object frmcons; | |
| 833 | |
| 834 /* First delete all frames without their own minibuffers, | |
| 835 to avoid errors coming from attempting to delete a frame | |
| 836 that is a surrogate for another frame. */ | |
| 837 DEVICE_FRAME_LOOP (frmcons, d) | |
| 838 { | |
| 839 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 840 /* delete_frame_internal() might do anything such as run hooks, | |
| 841 so be defensive. */ | |
| 842 if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f)) | |
| 843 delete_frame_internal (f, 1, 1, from_io_error); | |
| 844 | |
| 845 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't | |
| 846 go ahead and delete anything */ | |
| 847 { | |
| 848 UNGCPRO; | |
| 849 return; | |
| 850 } | |
| 851 } | |
| 852 | |
| 853 /* #### This should probably be a device method but it is time for | |
| 854 19.14 to go out the door. */ | |
| 1204 | 855 /* #### BILL!!! Should this deal with HAVE_MS_WINDOWS as well? */ |
| 462 | 856 #if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK) |
| 428 | 857 /* Next delete all frames which have the popup property to avoid |
| 858 deleting a child after its parent. */ | |
| 859 DEVICE_FRAME_LOOP (frmcons, d) | |
| 860 { | |
| 861 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 862 | |
| 863 if (FRAME_LIVE_P (f)) | |
| 864 { | |
| 865 Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil); | |
| 866 if (!NILP (popup)) | |
| 867 delete_frame_internal (f, 1, 1, from_io_error); | |
| 868 | |
| 869 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't | |
| 870 go ahead and delete anything */ | |
| 871 { | |
| 872 UNGCPRO; | |
| 873 return; | |
| 874 } | |
| 875 } | |
| 876 } | |
| 877 #endif /* HAVE_X_WINDOWS */ | |
| 878 | |
| 879 DEVICE_FRAME_LOOP (frmcons, d) | |
| 880 { | |
| 881 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 882 /* delete_frame_internal() might do anything such as run hooks, | |
| 883 so be defensive. */ | |
| 884 if (FRAME_LIVE_P (f)) | |
| 885 delete_frame_internal (f, 1, 1, from_io_error); | |
| 886 | |
| 887 if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't | |
| 888 go ahead and delete anything */ | |
| 889 { | |
| 890 UNGCPRO; | |
| 891 return; | |
| 892 } | |
| 893 } | |
| 894 } | |
| 895 | |
| 896 set_device_selected_frame (d, Qnil); | |
| 897 | |
| 898 /* try to select another device */ | |
| 899 | |
| 900 if (EQ (device, Fselected_device (DEVICE_CONSOLE (d)))) | |
| 901 { | |
| 902 Lisp_Object other_dev = find_other_device (device, 1); | |
| 903 if (!NILP (other_dev)) | |
| 904 Fselect_device (other_dev); | |
| 905 } | |
| 906 | |
| 907 if (EQ (device, Vdefault_device)) | |
| 908 Vdefault_device = find_other_device (device, 0); | |
| 909 | |
| 910 MAYBE_DEVMETH (d, delete_device, (d)); | |
| 911 | |
| 872 | 912 /* Now see if we're the default device, and thus need to be changed. */ |
| 913 { | |
| 914 /* Device type still OK, not set to null till down below. */ | |
| 915 Lisp_Object dt = DEVICE_TYPE (d); | |
| 916 | |
| 917 if (EQ (device, get_default_device (dt))) | |
| 918 { | |
| 919 Lisp_Object devcons, concons; | |
| 920 /* #### handle deleting last device */ | |
| 921 set_default_device (dt, Qnil); | |
| 922 DEVICE_LOOP_NO_BREAK (devcons, concons) | |
| 923 { | |
| 924 if (EQ (dt, XDEVICE_TYPE (XCAR (devcons))) && | |
| 925 !EQ (device, XCAR (devcons))) | |
| 926 { | |
| 927 set_default_device (dt, XCAR (devcons)); | |
| 928 goto double_break; | |
| 929 } | |
| 930 } | |
| 931 } | |
| 932 } | |
| 933 double_break: | |
| 934 | |
| 428 | 935 CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c)); |
| 617 | 936 |
| 428 | 937 RESET_CHANGED_SET_FLAGS; |
| 617 | 938 |
| 939 /* Nobody should be accessing anything in this object any more, and | |
| 940 making all Lisp_Objects Qnil allows for better GC'ing in case a | |
| 941 pointer to the dead device continues to hang around. Zero all | |
| 942 other structs in case someone tries to access something through | |
| 943 them. */ | |
| 944 nuke_all_device_slots (d, Qnil); | |
| 428 | 945 d->devmeths = dead_console_methods; |
| 1204 | 946 d->devtype = dead_console; |
| 853 | 947 note_object_deleted (device); |
| 617 | 948 |
| 428 | 949 UNGCPRO; |
| 950 } | |
| 951 | |
| 952 /* delete a device as a result of an I/O error. Called from | |
| 953 an enqueued magic-eval event. */ | |
| 954 | |
| 955 void | |
| 956 io_error_delete_device (Lisp_Object device) | |
| 957 { | |
| 958 /* Note: it's the console that should get deleted, but | |
| 959 delete_device_internal() contains a hack that also deletes the | |
| 960 console when called from this function. */ | |
| 961 delete_device_internal (XDEVICE (device), 1, 0, 1); | |
| 962 } | |
| 963 | |
| 964 DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /* | |
| 965 Delete DEVICE, permanently eliminating it from use. | |
| 966 Normally, you cannot delete the last non-minibuffer-only frame (you must | |
| 967 use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional | |
| 968 second argument FORCE is non-nil, you can delete the last frame. (This | |
| 969 will automatically call `save-buffers-kill-emacs'.) | |
| 970 */ | |
| 971 (device, force)) | |
| 972 { | |
| 973 CHECK_DEVICE (device); | |
| 974 delete_device_internal (XDEVICE (device), !NILP (force), 0, 0); | |
| 975 return Qnil; | |
| 976 } | |
| 977 | |
| 978 DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /* | |
| 979 Return a list of all frames on DEVICE. | |
| 980 If DEVICE is nil, the selected device will be used. | |
| 981 */ | |
| 982 (device)) | |
| 983 { | |
| 984 return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device))); | |
| 985 } | |
| 986 | |
| 987 DEFUN ("device-class", Fdevice_class, 0, 1, 0, /* | |
| 988 Return the class (color behavior) of DEVICE. | |
| 3025 | 989 This will be one of `color', `grayscale', or `mono'. |
| 428 | 990 */ |
| 991 (device)) | |
| 992 { | |
| 993 return DEVICE_CLASS (decode_device (device)); | |
| 994 } | |
| 995 | |
| 996 DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /* | |
| 997 Set the class (color behavior) of DEVICE. | |
| 3025 | 998 CLASS should be one of `color', `grayscale', or `mono'. |
| 428 | 999 This is only allowed on device such as TTY devices, where the color |
| 1000 behavior cannot necessarily be determined automatically. | |
| 1001 */ | |
| 1204 | 1002 (device, class_)) |
| 428 | 1003 { |
| 1004 struct device *d = decode_device (device); | |
| 793 | 1005 device = wrap_device (d); |
| 428 | 1006 if (!DEVICE_TTY_P (d)) |
| 563 | 1007 gui_error ("Cannot change the class of this device", device); |
| 1204 | 1008 if (!EQ (class_, Qcolor) && !EQ (class_, Qmono) && !EQ (class_, Qgrayscale)) |
| 1009 invalid_constant ("Must be color, mono, or grayscale", class_); | |
| 1010 if (! EQ (DEVICE_CLASS (d), class_)) | |
| 428 | 1011 { |
| 1012 Lisp_Object frmcons; | |
| 1204 | 1013 DEVICE_CLASS (d) = class_; |
| 428 | 1014 DEVICE_FRAME_LOOP (frmcons, d) |
| 1015 { | |
| 1016 struct frame *f = XFRAME (XCAR (frmcons)); | |
| 1017 | |
| 1018 recompute_all_cached_specifiers_in_frame (f); | |
| 1019 MARK_FRAME_FACES_CHANGED (f); | |
| 1020 MARK_FRAME_GLYPHS_CHANGED (f); | |
| 1021 MARK_FRAME_SUBWINDOWS_CHANGED (f); | |
| 1022 MARK_FRAME_TOOLBARS_CHANGED (f); | |
| 442 | 1023 MARK_FRAME_GUTTERS_CHANGED (f); |
| 428 | 1024 f->menubar_changed = 1; |
| 1025 } | |
| 1026 } | |
| 1027 return Qnil; | |
| 1028 } | |
| 1029 | |
| 1030 DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /* | |
| 1031 Set the output baud rate of DEVICE to RATE. | |
| 1032 On most systems, changing this value will affect the amount of padding | |
| 1033 and other strategic decisions made during redisplay. | |
| 1034 */ | |
| 1035 (device, rate)) | |
| 1036 { | |
| 1037 CHECK_INT (rate); | |
| 1038 | |
| 1039 DEVICE_BAUD_RATE (decode_device (device)) = XINT (rate); | |
| 1040 | |
| 1041 return rate; | |
| 1042 } | |
| 1043 | |
| 1044 DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /* | |
| 1045 Return the output baud rate of DEVICE. | |
| 1046 */ | |
| 1047 (device)) | |
| 1048 { | |
| 1049 return make_int (DEVICE_BAUD_RATE (decode_device (device))); | |
| 1050 } | |
| 1051 | |
| 440 | 1052 DEFUN ("device-printer-p", Fdevice_printer_p, 0, 1, 0, /* |
| 1053 Return t if DEVICE is a printer, nil if it is a display. DEVICE defaults | |
| 1054 to selected device if omitted, and must be live if specified. | |
| 1055 */ | |
| 1056 (device)) | |
| 1057 { | |
| 442 | 1058 return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil; |
| 440 | 1059 } |
| 1060 | |
| 428 | 1061 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /* |
| 1062 Get a metric for DEVICE as provided by the system. | |
| 1063 | |
| 1064 METRIC must be a symbol specifying requested metric. Note that the metrics | |
| 1065 returned are these provided by the system internally, not read from resources, | |
| 1066 so obtained from the most internal level. | |
| 1067 | |
| 1068 If a metric is not provided by the system, then DEFAULT is returned. | |
| 1069 | |
| 1070 When DEVICE is nil, selected device is assumed | |
| 1071 | |
| 1072 Metrics, by group, are: | |
| 1073 | |
| 1074 COLORS. Colors are returned as valid color instantiators. No other assumption | |
| 1075 on the returned value should be made (i.e. it can be a string on one system but | |
| 1076 a color instance on another). For colors, returned value is a cons of | |
| 1077 foreground and background colors. Note that if the system provides only one | |
| 1078 color of the pair, the second one may be nil. | |
| 1079 | |
| 1080 color-default Standard window text foreground and background. | |
| 1081 color-select Selection highlight text and background colors. | |
| 1082 color-balloon Balloon popup text and background colors. | |
| 1083 color-3d-face 3-D object (button, modeline) text and surface colors. | |
| 1084 color-3d-light Fore and back colors for 3-D edges facing light source. | |
| 1085 color-3d-dark Fore and back colors for 3-D edges facing away from | |
| 1086 light source. | |
| 1087 color-menu Text and background for menus | |
| 1088 color-menu-highlight Selected menu item colors | |
| 1089 color-menu-button Menu button colors | |
| 1090 color-menu-disabled Unselectable menu item colors | |
| 1091 color-toolbar Toolbar foreground and background colors | |
| 1092 color-scrollbar Scrollbar foreground and background colors | |
| 1093 color-desktop Desktop window colors | |
| 1094 color-workspace Workspace window colors | |
| 1095 | |
| 1096 FONTS. Fonts are returned as valid font instantiators. No other assumption on | |
| 1097 the returned value should be made (i.e. it can be a string on one system but | |
| 1098 font instance on another). | |
| 1099 | |
| 1100 font-default Default fixed width font. | |
| 1101 font-menubar Menubar font | |
| 1102 font-dialog Dialog boxes font | |
| 1103 | |
| 1104 GEOMETRY. These metrics are returned as conses of (X . Y). As with colors, | |
| 1105 either car or cdr of the cons may be nil if the system does not provide one | |
| 1106 of the corresponding dimensions. | |
| 1107 | |
| 1108 size-cursor Mouse cursor size. | |
| 1109 size-scrollbar Scrollbars (WIDTH . HEIGHT) | |
| 1110 size-menu Menubar height, as (nil . HEIGHT) | |
| 1111 size-toolbar Toolbar width and height. | |
| 1112 size-toolbar-button Toolbar button size. | |
| 1113 size-toolbar-border Toolbar border width and height. | |
| 1114 size-icon Icon dimensions. | |
| 1115 size-icon-small Small icon dimensions. | |
| 440 | 1116 size-device Device screen or paper size in pixels. |
| 1117 size-workspace Workspace size in pixels. This can be less than or | |
| 442 | 1118 equal to the above. For displays, this is the area |
| 1119 available to applications less window manager | |
| 440 | 1120 decorations. For printers, this is the size of |
| 1121 printable area. | |
| 1122 offset-workspace Offset of workspace area from the top left corner | |
| 442 | 1123 of screen or paper, in pixels. |
| 428 | 1124 size-device-mm Device screen size in millimeters. |
| 1125 device-dpi Device resolution, in dots per inch. | |
| 1126 num-bit-planes Integer, number of device bit planes. | |
| 1127 num-color-cells Integer, number of device color cells. | |
| 1942 | 1128 num-screens Integer, number of device screens. |
| 428 | 1129 |
| 1130 FEATURES. This group reports various device features. If a feature is | |
| 1131 present, integer 1 (one) is returned, if it is not present, then integer | |
| 1132 0 (zero) is returned. If the system is unaware of the feature, then | |
| 1133 DEFAULT is returned. | |
| 1134 | |
| 1135 mouse-buttons Integer, number of mouse buttons, or zero if no mouse. | |
| 1136 swap-buttons Non-zero if left and right mouse buttons are swapped. | |
| 1137 show-sounds User preference for visual over audible bell. | |
| 1138 slow-device Device is slow, avoid animation. | |
| 1139 security Non-zero if user environment is secure. | |
| 1140 */ | |
| 1141 (device, metric, default_)) | |
| 1142 { | |
| 1143 struct device *d = decode_device (device); | |
| 1144 enum device_metrics m; | |
| 1145 Lisp_Object res; | |
| 1146 | |
| 1147 /* Decode metric */ | |
| 1148 #define FROB(met) \ | |
| 1149 else if (EQ (metric, Q##met)) \ | |
| 1150 m = DM_##met | |
| 1151 | |
| 1152 if (0) | |
| 1153 ; | |
| 1154 FROB (color_default); | |
| 1155 FROB (color_select); | |
| 1156 FROB (color_balloon); | |
| 1157 FROB (color_3d_face); | |
| 1158 FROB (color_3d_light); | |
| 1159 FROB (color_3d_dark); | |
| 1160 FROB (color_menu); | |
| 1161 FROB (color_menu_highlight); | |
| 1162 FROB (color_menu_button); | |
| 1163 FROB (color_menu_disabled); | |
| 1164 FROB (color_toolbar); | |
| 1165 FROB (color_scrollbar); | |
| 1166 FROB (color_desktop); | |
| 1167 FROB (color_workspace); | |
| 1168 FROB (font_default); | |
| 1169 FROB (font_menubar); | |
| 1170 FROB (font_dialog); | |
| 1171 FROB (size_cursor); | |
| 1172 FROB (size_scrollbar); | |
| 1173 FROB (size_menu); | |
| 1174 FROB (size_toolbar); | |
| 1175 FROB (size_toolbar_button); | |
| 1176 FROB (size_toolbar_border); | |
| 1177 FROB (size_icon); | |
| 1178 FROB (size_icon_small); | |
| 1179 FROB (size_device); | |
| 1180 FROB (size_workspace); | |
| 440 | 1181 FROB (offset_workspace); |
| 428 | 1182 FROB (size_device_mm); |
| 1183 FROB (device_dpi); | |
| 1184 FROB (num_bit_planes); | |
| 1185 FROB (num_color_cells); | |
| 1942 | 1186 FROB (num_screens); |
| 428 | 1187 FROB (mouse_buttons); |
| 1188 FROB (swap_buttons); | |
| 1189 FROB (show_sounds); | |
| 1190 FROB (slow_device); | |
| 1191 FROB (security); | |
| 1942 | 1192 FROB (backing_store); |
| 1193 FROB (save_under); | |
| 428 | 1194 else |
| 563 | 1195 invalid_constant ("Invalid device metric symbol", metric); |
| 428 | 1196 |
| 1197 res = DEVMETH_OR_GIVEN (d, device_system_metrics, (d, m), Qunbound); | |
| 1198 return UNBOUNDP(res) ? default_ : res; | |
| 1199 | |
| 1200 #undef FROB | |
| 1201 } | |
| 1202 | |
| 1203 DEFUN ("device-system-metrics", Fdevice_system_metrics, 0, 1, 0, /* | |
| 1204 Get a property list of device metric for DEVICE. | |
| 1205 | |
| 1206 See `device-system-metric' for the description of available metrics. | |
| 1207 DEVICE defaults to selected device when omitted. | |
| 1208 */ | |
| 1209 (device)) | |
| 1210 { | |
| 1211 struct device *d = decode_device (device); | |
| 1212 Lisp_Object plist = Qnil, one_metric; | |
| 1213 | |
| 1214 #define FROB(m) \ | |
| 1215 if (!UNBOUNDP ((one_metric = \ | |
| 1216 DEVMETH_OR_GIVEN (d, device_system_metrics, \ | |
| 1217 (d, DM_##m), Qunbound)))) \ | |
| 1218 plist = Fcons (Q##m, Fcons (one_metric, plist)); | |
| 1219 | |
| 1220 FROB (color_default); | |
| 1221 FROB (color_select); | |
| 1222 FROB (color_balloon); | |
| 1223 FROB (color_3d_face); | |
| 1224 FROB (color_3d_light); | |
| 1225 FROB (color_3d_dark); | |
| 1226 FROB (color_menu); | |
| 1227 FROB (color_menu_highlight); | |
| 1228 FROB (color_menu_button); | |
| 1229 FROB (color_menu_disabled); | |
| 1230 FROB (color_toolbar); | |
| 1231 FROB (color_scrollbar); | |
| 1232 FROB (color_desktop); | |
| 1233 FROB (color_workspace); | |
| 1234 FROB (font_default); | |
| 1235 FROB (font_menubar); | |
| 1236 FROB (font_dialog); | |
| 1237 FROB (size_cursor); | |
| 1238 FROB (size_scrollbar); | |
| 1239 FROB (size_menu); | |
| 1240 FROB (size_toolbar); | |
| 1241 FROB (size_toolbar_button); | |
| 1242 FROB (size_toolbar_border); | |
| 1243 FROB (size_icon); | |
| 1244 FROB (size_icon_small); | |
| 1245 FROB (size_device); | |
| 1246 FROB (size_workspace); | |
| 440 | 1247 FROB (offset_workspace); |
| 428 | 1248 FROB (size_device_mm); |
| 1249 FROB (device_dpi); | |
| 1250 FROB (num_bit_planes); | |
| 1251 FROB (num_color_cells); | |
| 1942 | 1252 FROB (num_screens); |
| 428 | 1253 FROB (mouse_buttons); |
| 1254 FROB (swap_buttons); | |
| 1255 FROB (show_sounds); | |
| 1256 FROB (slow_device); | |
| 1257 FROB (security); | |
| 1942 | 1258 FROB (backing_store); |
| 1259 FROB (save_under); | |
| 428 | 1260 |
| 1261 return plist; | |
| 1262 | |
| 1263 #undef FROB | |
| 1264 } | |
| 1265 | |
| 1266 Lisp_Object | |
| 1267 domain_device_type (Lisp_Object domain) | |
| 1268 { | |
| 1269 /* This cannot GC */ | |
| 1270 assert (WINDOWP (domain) || FRAMEP (domain) | |
| 1271 || DEVICEP (domain) || CONSOLEP (domain)); | |
| 1272 | |
| 1273 if (WINDOWP (domain)) | |
| 1274 { | |
| 1275 if (!WINDOW_LIVE_P (XWINDOW (domain))) | |
| 1276 return Qdead; | |
| 1277 domain = WINDOW_FRAME (XWINDOW (domain)); | |
| 1278 } | |
| 1279 if (FRAMEP (domain)) | |
| 1280 { | |
| 1281 if (!FRAME_LIVE_P (XFRAME (domain))) | |
| 1282 return Qdead; | |
| 1283 domain = FRAME_DEVICE (XFRAME (domain)); | |
| 1284 } | |
| 1285 if (DEVICEP (domain)) | |
| 1286 { | |
| 1287 if (!DEVICE_LIVE_P (XDEVICE (domain))) | |
| 1288 return Qdead; | |
| 1289 domain = DEVICE_CONSOLE (XDEVICE (domain)); | |
| 1290 } | |
| 1291 return CONSOLE_TYPE (XCONSOLE (domain)); | |
| 1292 } | |
| 1293 | |
| 1294 /* | |
| 1295 * Determine whether window system bases window geometry on character | |
| 1296 * or pixel counts. | |
| 1297 * Return non-zero for pixel-based geometry, zero for character-based. | |
| 1298 */ | |
| 1299 int | |
| 1300 window_system_pixelated_geometry (Lisp_Object domain) | |
| 1301 { | |
| 1302 /* This cannot GC */ | |
| 1303 Lisp_Object winsy = domain_device_type (domain); | |
| 1304 struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT); | |
| 1305 assert (meth); | |
| 545 | 1306 return CONMETH_IMPL_FLAG (meth, XDEVIMPF_PIXEL_GEOMETRY); |
| 428 | 1307 } |
| 1308 | |
| 1309 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /* | |
| 3025 | 1310 Return the device type symbol for a DOMAIN, e.g. `x' or `tty'. |
| 428 | 1311 DOMAIN can be either a window, frame, device or console. |
| 1312 */ | |
| 1313 (domain)) | |
| 1314 { | |
| 1315 if (!WINDOWP (domain) && !FRAMEP (domain) | |
| 1316 && !DEVICEP (domain) && !CONSOLEP (domain)) | |
| 563 | 1317 invalid_argument |
| 428 | 1318 ("Domain must be either a window, frame, device or console", domain); |
| 1319 | |
| 1320 return domain_device_type (domain); | |
| 1321 } | |
| 1322 | |
| 1323 void | |
| 1324 handle_asynch_device_change (void) | |
| 1325 { | |
| 1326 int i; | |
| 1327 int old_asynch_device_change_pending = asynch_device_change_pending; | |
| 1328 for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) | |
| 1329 { | |
| 1330 if (Dynarr_at (the_console_type_entry_dynarr, i).meths-> | |
| 1331 asynch_device_change_method) | |
| 1332 (Dynarr_at (the_console_type_entry_dynarr, i).meths-> | |
| 1333 asynch_device_change_method) (); | |
| 1334 } | |
| 1335 /* reset the flag to 0 unless another notification occurred while | |
| 1336 we were processing this one. Block SIGWINCH during this | |
| 1337 check to prevent a possible race condition. */ | |
| 442 | 1338 #ifdef SIGWINCH |
| 428 | 1339 EMACS_BLOCK_SIGNAL (SIGWINCH); |
| 1340 #endif | |
| 1341 if (old_asynch_device_change_pending == asynch_device_change_pending) | |
| 1342 asynch_device_change_pending = 0; | |
| 442 | 1343 #ifdef SIGWINCH |
| 428 | 1344 EMACS_UNBLOCK_SIGNAL (SIGWINCH); |
| 1345 #endif | |
| 1346 } | |
| 1347 | |
| 771 | 1348 static Lisp_Object |
| 1349 unlock_device (Lisp_Object d) | |
| 1350 { | |
| 1351 UNLOCK_DEVICE (XDEVICE (d)); | |
| 1352 return Qnil; | |
| 1353 } | |
| 1354 | |
| 872 | 1355 Lisp_Object |
| 428 | 1356 call_critical_lisp_code (struct device *d, Lisp_Object function, |
| 1357 Lisp_Object object) | |
| 1358 { | |
| 853 | 1359 /* This function cannot GC */ |
| 771 | 1360 int count = begin_gc_forbidden (); |
| 853 | 1361 struct gcpro gcpro1; |
| 1362 Lisp_Object args[3]; | |
| 872 | 1363 Lisp_Object retval; |
| 853 | 1364 |
| 771 | 1365 specbind (Qinhibit_quit, Qt); |
| 1366 record_unwind_protect (unlock_device, wrap_device (d)); | |
| 428 | 1367 |
| 771 | 1368 /* [[There's no real reason to bother doing unwind-protects, because if |
| 428 | 1369 initialize-*-faces signals an error, emacs is going to crash |
| 771 | 1370 immediately.]] But this sucks! This code is called not only during |
| 1371 the initial device, but for other devices as well! #### When dealing | |
| 1372 with non-initial devices, we should signal an error but NOT kill | |
| 1373 ourselves! --ben | |
| 428 | 1374 */ |
| 1375 LOCK_DEVICE (d); | |
| 1376 | |
| 853 | 1377 args[0] = Qreally_early_error_handler; |
| 1378 args[1] = function; | |
| 1379 args[2] = object; | |
| 1380 | |
| 1381 GCPRO1_ARRAY (args, 3); | |
| 1382 | |
| 1383 /* It's useful to have an error handler; otherwise an infinite | |
| 428 | 1384 loop may result. */ |
| 872 | 1385 retval = Fcall_with_condition_handler (!NILP (object) ? 3 : 2, args); |
| 853 | 1386 |
| 1387 UNGCPRO; | |
| 428 | 1388 |
| 872 | 1389 return unbind_to_1 (count, retval); |
| 428 | 1390 } |
| 1391 | |
| 1392 | |
| 1393 /************************************************************************/ | |
| 1394 /* initialization */ | |
| 1395 /************************************************************************/ | |
| 1396 | |
| 1397 void | |
| 1398 syms_of_device (void) | |
| 1399 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1400 INIT_LISP_OBJECT (device); |
| 442 | 1401 |
| 428 | 1402 DEFSUBR (Fvalid_device_class_p); |
| 1403 DEFSUBR (Fdevice_class_list); | |
| 1404 | |
| 1405 DEFSUBR (Fdfw_device); | |
| 1406 DEFSUBR (Fselected_device); | |
| 1407 DEFSUBR (Fselect_device); | |
| 1408 DEFSUBR (Fset_device_selected_frame); | |
| 1409 DEFSUBR (Fdevicep); | |
| 1410 DEFSUBR (Fdevice_live_p); | |
| 1411 DEFSUBR (Fdevice_name); | |
| 1412 DEFSUBR (Fdevice_connection); | |
| 1413 DEFSUBR (Fdevice_console); | |
| 1414 DEFSUBR (Ffind_device); | |
| 1415 DEFSUBR (Fget_device); | |
| 1416 DEFSUBR (Fmake_device); | |
| 872 | 1417 DEFSUBR (Fdefault_device); |
| 428 | 1418 DEFSUBR (Fdelete_device); |
| 1419 DEFSUBR (Fdevice_frame_list); | |
| 1420 DEFSUBR (Fdevice_class); | |
| 1421 DEFSUBR (Fset_device_class); | |
| 1422 DEFSUBR (Fdevice_system_metrics); | |
| 1423 DEFSUBR (Fdevice_system_metric); | |
| 1424 DEFSUBR (Fset_device_baud_rate); | |
| 1425 DEFSUBR (Fdevice_baud_rate); | |
| 1426 DEFSUBR (Fdomain_device_type); | |
| 440 | 1427 DEFSUBR (Fdevice_printer_p); |
| 428 | 1428 |
| 563 | 1429 DEFSYMBOL (Qdevicep); |
| 1430 DEFSYMBOL (Qdevice_live_p); | |
| 428 | 1431 |
| 563 | 1432 DEFSYMBOL (Qcreate_device_hook); |
| 1433 DEFSYMBOL (Qdelete_device_hook); | |
| 428 | 1434 |
| 1435 /* Qcolor defined in general.c */ | |
| 563 | 1436 DEFSYMBOL (Qgrayscale); |
| 1437 DEFSYMBOL (Qmono); | |
| 428 | 1438 |
| 1439 /* Device metrics symbols */ | |
| 1942 | 1440 DEFSYMBOL (Qbacking_store); |
| 563 | 1441 DEFSYMBOL (Qcolor_default); |
| 1442 DEFSYMBOL (Qcolor_select); | |
| 1443 DEFSYMBOL (Qcolor_balloon); | |
| 1444 DEFSYMBOL (Qcolor_3d_face); | |
| 1445 DEFSYMBOL (Qcolor_3d_light); | |
| 1446 DEFSYMBOL (Qcolor_3d_dark); | |
| 1447 DEFSYMBOL (Qcolor_menu); | |
| 1448 DEFSYMBOL (Qcolor_menu_highlight); | |
| 1449 DEFSYMBOL (Qcolor_menu_button); | |
| 1450 DEFSYMBOL (Qcolor_menu_disabled); | |
| 1451 DEFSYMBOL (Qcolor_toolbar); | |
| 1452 DEFSYMBOL (Qcolor_scrollbar); | |
| 1453 DEFSYMBOL (Qcolor_desktop); | |
| 1454 DEFSYMBOL (Qcolor_workspace); | |
| 1455 DEFSYMBOL (Qfont_default); | |
| 1456 DEFSYMBOL (Qfont_menubar); | |
| 1457 DEFSYMBOL (Qfont_dialog); | |
| 1458 DEFSYMBOL (Qsize_cursor); | |
| 1459 DEFSYMBOL (Qsize_scrollbar); | |
| 1460 DEFSYMBOL (Qsize_menu); | |
| 1461 DEFSYMBOL (Qsize_toolbar); | |
| 1462 DEFSYMBOL (Qsize_toolbar_button); | |
| 1463 DEFSYMBOL (Qsize_toolbar_border); | |
| 1464 DEFSYMBOL (Qsize_icon); | |
| 1465 DEFSYMBOL (Qsize_icon_small); | |
| 1466 DEFSYMBOL (Qsize_device); | |
| 1467 DEFSYMBOL (Qsize_workspace); | |
| 1468 DEFSYMBOL (Qoffset_workspace); | |
| 1469 DEFSYMBOL (Qsize_device_mm); | |
| 1470 DEFSYMBOL (Qnum_bit_planes); | |
| 1471 DEFSYMBOL (Qnum_color_cells); | |
| 1942 | 1472 DEFSYMBOL (Qnum_screens); |
| 563 | 1473 DEFSYMBOL (Qdevice_dpi); |
| 1474 DEFSYMBOL (Qmouse_buttons); | |
| 1942 | 1475 DEFSYMBOL (Qsave_under); |
| 563 | 1476 DEFSYMBOL (Qswap_buttons); |
| 1477 DEFSYMBOL (Qshow_sounds); | |
| 1478 DEFSYMBOL (Qslow_device); | |
| 1479 DEFSYMBOL (Qsecurity); | |
| 428 | 1480 } |
| 1481 | |
| 1482 void | |
| 1483 reinit_vars_of_device (void) | |
| 1484 { | |
| 1485 staticpro_nodump (&Vdefault_device); | |
| 1486 Vdefault_device = Qnil; | |
| 1487 asynch_device_change_pending = 0; | |
| 1488 } | |
| 1489 | |
| 1490 void | |
| 1491 vars_of_device (void) | |
| 1492 { | |
| 1493 DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /* | |
| 1494 Function or functions to call when a device is created. | |
| 1495 One argument, the newly-created device. | |
| 1496 This is called after the first frame has been created, but before | |
| 1497 calling the `create-frame-hook'. | |
| 1498 Note that in general the device will not be selected. | |
| 1499 */ ); | |
| 1500 Vcreate_device_hook = Qnil; | |
| 1501 | |
| 1502 DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook /* | |
| 1503 Function or functions to call when a device is deleted. | |
| 1504 One argument, the to-be-deleted device. | |
| 1505 */ ); | |
| 1506 Vdelete_device_hook = Qnil; | |
| 1507 | |
| 872 | 1508 /* Plist of device types and their default devices. */ |
| 1509 Vdefault_device_plist = Qnil; | |
| 1510 staticpro (&Vdefault_device_plist); | |
| 1511 | |
| 428 | 1512 Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono); |
| 1513 staticpro (&Vdevice_class_list); | |
| 1514 | |
| 1515 /* Death to devices.el !!! */ | |
| 617 | 1516 Fprovide (intern ("devices")); |
| 428 | 1517 } |