Mercurial > hg > xemacs-beta

comparison src/device.c @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents b2472a1930f2
children c42ec1d1cded
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
61 Lisp_Object Qcreate_device_hook; 61 Lisp_Object Qcreate_device_hook;
62 Lisp_Object Qdelete_device_hook; 62 Lisp_Object Qdelete_device_hook;
63 63
64 Lisp_Object Vdevice_class_list; 64 Lisp_Object Vdevice_class_list;
65 65
66 MAC_DEFINE (struct device *, MTdevice_data)
67
68 66
69 static Lisp_Object mark_device (Lisp_Object, void (*) (Lisp_Object));
70 static void print_device (Lisp_Object, Lisp_Object, int);
71 DEFINE_LRECORD_IMPLEMENTATION ("device", device,
72 mark_device, print_device, 0, 0, 0,
73 struct device);
74
75 static Lisp_Object 67 static Lisp_Object
76 mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object)) 68 mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object))
77 { 69 {
78 struct device *d = XDEVICE (obj); 70 struct device *d = XDEVICE (obj);
79 71
126 } 118 }
127 sprintf (buf, " 0x%x>", d->header.uid); 119 sprintf (buf, " 0x%x>", d->header.uid);
128 write_c_string (buf, printcharfun); 120 write_c_string (buf, printcharfun);
129 } 121 }
130 122
123 DEFINE_LRECORD_IMPLEMENTATION ("device", device,
124 mark_device, print_device, 0, 0, 0,
125 struct device);
131 126
132 int 127 int
133 valid_device_class_p (Lisp_Object class) 128 valid_device_class_p (Lisp_Object class)
134 { 129 {
135 return !NILP (memq_no_quit (class, Vdevice_class_list)); 130 return !NILP (memq_no_quit (class, Vdevice_class_list));
212 device = FRAME_DEVICE (decode_frame (device)); 207 device = FRAME_DEVICE (decode_frame (device));
213 CHECK_LIVE_DEVICE (device); 208 CHECK_LIVE_DEVICE (device);
214 return XDEVICE (device); 209 return XDEVICE (device);
215 } 210 }
216 211
217 Lisp_Object
218 make_device (struct device *d)
219 {
220 Lisp_Object device = Qnil;
221 XSETDEVICE (device, d);
222 return device;
223 }
224
225 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /* 212 DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /*
226 Given a device, frame, or window, return the associated device. 213 Given a device, frame, or window, return the associated device.
227 Return nil otherwise. 214 Return nil otherwise.
228 */ 215 */
229 (obj)) 216 (obj))
294 If DEVICE is nil, the selected device is used. 281 If DEVICE is nil, the selected device is used.
295 If DEVICE is the selected device, this makes FRAME the selected frame. 282 If DEVICE is the selected device, this makes FRAME the selected frame.
296 */ 283 */
297 (device, frame)) 284 (device, frame))
298 { 285 {
299 struct device *d = decode_device (device); 286 XSETDEVICE (device, decode_device (device));
300
301 XSETDEVICE (device, d);
302 CHECK_LIVE_FRAME (frame); 287 CHECK_LIVE_FRAME (frame);
303 288
304 if (! EQ (device, FRAME_DEVICE (XFRAME (frame)))) 289 if (! EQ (device, FRAME_DEVICE (XFRAME (frame))))
305 error ("In `set-device-selected-frame', FRAME is not on DEVICE"); 290 error ("In `set-device-selected-frame', FRAME is not on DEVICE");
306 291
351 */ 336 */
352 (device)) 337 (device))
353 { 338 {
354 return DEVICE_CONSOLE (decode_device (device)); 339 return DEVICE_CONSOLE (decode_device (device));
355 } 340 }
356
357 #ifdef HAVE_X_WINDOWS
358 extern Lisp_Object Vdefault_x_device;
359 #endif
360 341
361 #ifdef HAVE_WINDOW_SYSTEM 342 #ifdef HAVE_WINDOW_SYSTEM
362 343
363 static void 344 static void
364 init_global_resources (struct device *d) 345 init_global_resources (struct device *d)
489 } 470 }
490 return device; 471 return device;
491 } 472 }
492 473
493 static Lisp_Object 474 static Lisp_Object
494 delete_deviceless_console(Lisp_Object console) 475 delete_deviceless_console (Lisp_Object console)
495 { 476 {
496 if (NILP (XCONSOLE (console)->device_list)) 477 if (NILP (XCONSOLE (console)->device_list))
497 Fdelete_console (console, Qnil); 478 Fdelete_console (console, Qnil);
498 return Qnil; 479 return Qnil;
499 } 480 }
500 481
501 DEFUN ("make-device", Fmake_device, 2, 3, 0, /* 482 DEFUN ("make-device", Fmake_device, 2, 3, 0, /*
502 Create a new device of type TYPE, attached to connection CONNECTION. 483 Return a new device of type TYPE, attached to connection CONNECTION.
503 484
504 The valid values for CONNECTION are device-specific; however, 485 The valid values for CONNECTION are device-specific; however,
505 CONNECTION is generally a string. (Specifically, for X devices, 486 CONNECTION is generally a string. (Specifically, for X devices,
506 CONNECTION should be a display specification such as "foo:0", and 487 CONNECTION should be a display specification such as "foo:0", and
507 for TTY devices, CONNECTION should be the filename of a TTY device 488 for TTY devices, CONNECTION should be the filename of a TTY device
558 539
559 name = Fplist_get (props, Qname, Qnil); 540 name = Fplist_get (props, Qname, Qnil);
560 541
561 { 542 {
562 Lisp_Object conconnect = 543 Lisp_Object conconnect =
563 CONTYPE_METH_OR_GIVEN (conmeths, 544 (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ?
564 device_to_console_connection, 545 CONTYPE_METH (conmeths, device_to_console_connection,
565 (connection, ERROR_ME), 546 (connection, ERROR_ME)) :
566 connection); 547 connection;
567 console = create_console (name, type, conconnect, props); 548 console = create_console (name, type, conconnect, props);
568 } 549 }
569 550
570 record_unwind_protect(delete_deviceless_console, console); 551 record_unwind_protect(delete_deviceless_console, console);
571 552
574 XSETDEVICE (device, d); 555 XSETDEVICE (device, d);
575 556
576 d->devmeths = con->conmeths; 557 d->devmeths = con->conmeths;
577 558
578 DEVICE_NAME (d) = name; 559 DEVICE_NAME (d) = name;
579 DEVICE_CONNECTION (d) = semi_canonicalize_device_connection (conmeths, 560 DEVICE_CONNECTION (d) =
580 connection, 561 semi_canonicalize_device_connection (conmeths, connection, ERROR_ME);
581 ERROR_ME); 562 DEVICE_CANON_CONNECTION (d) =
582 DEVICE_CANON_CONNECTION (d) = canonicalize_device_connection (conmeths, 563 canonicalize_device_connection (conmeths, connection, ERROR_ME);
583 connection,
584 ERROR_ME);
585 564
586 MAYBE_DEVMETH (d, init_device, (d, props)); 565 MAYBE_DEVMETH (d, init_device, (d, props));
587 566
588 /* Do it this way so that the device list is in order of creation */ 567 /* Do it this way so that the device list is in order of creation */
589 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil)); 568 con->device_list = nconc2 (con->device_list, Fcons (device, Qnil));
616 devices over stream devices. Maybe stay on the same console. */ 595 devices over stream devices. Maybe stay on the same console. */
617 596
618 static Lisp_Object 597 static Lisp_Object
619 find_other_device (Lisp_Object device, int on_same_console) 598 find_other_device (Lisp_Object device, int on_same_console)
620 { 599 {
621 Lisp_Object devcons = Qnil, concons = Qnil; 600 Lisp_Object devcons = Qnil, concons;
622 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device)); 601 Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device));
623 602
624 /* look for a non-stream device */ 603 /* look for a non-stream device */
625 DEVICE_LOOP_NO_BREAK (devcons, concons) 604 DEVICE_LOOP_NO_BREAK (devcons, concons)
626 { 605 {
693 int called_from_delete_console, 672 int called_from_delete_console,
694 int from_io_error) 673 int from_io_error)
695 { 674 {
696 /* This function can GC */ 675 /* This function can GC */
697 struct console *c; 676 struct console *c;
698 Lisp_Object device = Qnil; 677 Lisp_Object device;
699 struct gcpro gcpro1; 678 struct gcpro gcpro1;
700 679
701 /* OK to delete an already-deleted device. */ 680 /* OK to delete an already-deleted device. */
702 if (!DEVICE_LIVE_P (d)) 681 if (!DEVICE_LIVE_P (d))
703 return; 682 return;
871 XSETDEVICE (device, d); 850 XSETDEVICE (device, d);
872 if (!DEVICE_TTY_P (d)) 851 if (!DEVICE_TTY_P (d))
873 signal_simple_error ("Cannot change the class of this device", device); 852 signal_simple_error ("Cannot change the class of this device", device);
874 if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale)) 853 if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale))
875 signal_simple_error ("Must be color, mono, or grayscale", class); 854 signal_simple_error ("Must be color, mono, or grayscale", class);
876 DEVICE_CLASS (d) = class; 855 if (! EQ (DEVICE_CLASS (d), class))
856 {
857 Lisp_Object frmcons;
858 DEVICE_CLASS (d) = class;
859 DEVICE_FRAME_LOOP (frmcons, d)
860 {
861 struct frame *f = XFRAME (XCAR (frmcons));
862
863 recompute_all_cached_specifiers_in_frame (f);
864 MARK_FRAME_FACES_CHANGED (f);
865 MARK_FRAME_GLYPHS_CHANGED (f);
866 MARK_FRAME_TOOLBARS_CHANGED (f);
867 f->menubar_changed = 1;
868 }
869 }
877 return Qnil; 870 return Qnil;
878 } 871 }
879 872
880 DEFUN ("device-pixel-width", Fdevice_pixel_width, 0, 1, 0, /* 873 DEFUN ("device-pixel-width", Fdevice_pixel_width, 0, 1, 0, /*
881 Return the width in pixels of DEVICE, or nil if unknown. 874 Return the width in pixels of DEVICE, or nil if unknown.