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