XEmacs 21.4.5 "Civil Service".

[chise/xemacs-chise.git.1] / src / device.c

diff --git a/src/device.c b/src/device.c
index 4c1feab..399d61d 100644 (file)
--- a/src/device.c
+++ b/src/device.c
@@ -1,4 +1,4 @@
- /* Generic device functions.
+/* Generic device functions.

    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
    Copyright (C) 1994, 1995 Free Software Foundation, Inc.
    Copyright (C) 1995, 1996 Ben Wing
    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
    Copyright (C) 1994, 1995 Free Software Foundation, Inc.
    Copyright (C) 1995, 1996 Ben Wing

@@ -68,46 +68,45 @@ Lisp_Object
   Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar,
   Qsize_menu, Qsize_toolbar, Qsize_toolbar_button,
   Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device,
   Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar,
   Qsize_menu, Qsize_toolbar, Qsize_toolbar_button,
   Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device,

-  Qsize_workspace, Qsize_device_mm, Qdevice_dpi, Qnum_bit_planes,
-  Qnum_color_cells, Qmouse_buttons, Qswap_buttons, Qshow_sounds,
-  Qslow_device, Qsecurity;
+  Qsize_workspace, Qoffset_workspace, Qsize_device_mm, Qdevice_dpi,
+  Qnum_bit_planes, Qnum_color_cells, Qmouse_buttons, Qswap_buttons,
+  Qshow_sounds, Qslow_device, Qsecurity;

 
 Lisp_Object Qdevicep, Qdevice_live_p;
 
 Lisp_Object Qdevicep, Qdevice_live_p;

-Lisp_Object Qdelete_device;

 Lisp_Object Qcreate_device_hook;
 Lisp_Object Qdelete_device_hook;
 Lisp_Object Vdevice_class_list;
 
 \f
 static Lisp_Object
 Lisp_Object Qcreate_device_hook;
 Lisp_Object Qdelete_device_hook;
 Lisp_Object Vdevice_class_list;
 
 \f
 static Lisp_Object

-mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_device (Lisp_Object obj)

 {
   struct device *d = XDEVICE (obj);
 
 {
   struct device *d = XDEVICE (obj);
 

-  markobj (d->name);
-  markobj (d->connection);
-  markobj (d->canon_connection);
-  markobj (d->console);
-  markobj (d->selected_frame);
-  markobj (d->frame_with_focus_real);
-  markobj (d->frame_with_focus_for_hooks);
-  markobj (d->frame_that_ought_to_have_focus);
-  markobj (d->device_class);
-  markobj (d->user_defined_tags);
-  markobj (d->pixel_to_glyph_cache.obj1);
-  markobj (d->pixel_to_glyph_cache.obj2);
-
-  markobj (d->color_instance_cache);
-  markobj (d->font_instance_cache);
+  mark_object (d->name);
+  mark_object (d->connection);
+  mark_object (d->canon_connection);
+  mark_object (d->console);
+  mark_object (d->selected_frame);
+  mark_object (d->frame_with_focus_real);
+  mark_object (d->frame_with_focus_for_hooks);
+  mark_object (d->frame_that_ought_to_have_focus);
+  mark_object (d->device_class);
+  mark_object (d->user_defined_tags);
+  mark_object (d->pixel_to_glyph_cache.obj1);
+  mark_object (d->pixel_to_glyph_cache.obj2);
+
+  mark_object (d->color_instance_cache);
+  mark_object (d->font_instance_cache);

 #ifdef MULE
 #ifdef MULE

-  markobj (d->charset_font_cache);
+  mark_object (d->charset_font_cache);

 #endif
 #endif

-  markobj (d->image_instance_cache);
+  mark_object (d->image_instance_cache);

 
   if (d->devmeths)
     {
 
   if (d->devmeths)
     {

-      markobj (d->devmeths->symbol);
-      MAYBE_DEVMETH (d, mark_device, (d, markobj));
+      mark_object (d->devmeths->symbol);
+      MAYBE_DEVMETH (d, mark_device, (d));

     }
 
   return (d->frame_list);
     }
 
   return (d->frame_list);

@@ -126,7 +125,7 @@ print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
   sprintf (buf, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" :
           DEVICE_TYPE_NAME (d));
   write_c_string (buf, printcharfun);
   sprintf (buf, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" :
           DEVICE_TYPE_NAME (d));
   write_c_string (buf, printcharfun);

-  if (DEVICE_LIVE_P (d))
+  if (DEVICE_LIVE_P (d) && !NILP (DEVICE_CONNECTION (d)))

     {
       write_c_string (" on ", printcharfun);
       print_internal (DEVICE_CONNECTION (d), printcharfun, 1);
     {
       write_c_string (" on ", printcharfun);
       print_internal (DEVICE_CONNECTION (d), printcharfun, 1);

@@ -136,7 +135,7 @@ print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 }
 
 DEFINE_LRECORD_IMPLEMENTATION ("device", device,
 }
 
 DEFINE_LRECORD_IMPLEMENTATION ("device", device,

-                              mark_device, print_device, 0, 0, 0,
+                              mark_device, print_device, 0, 0, 0, 0,

                               struct device);
 \f
 int
                               struct device);
 \f
 int

@@ -166,7 +165,7 @@ static struct device *
 allocate_device (Lisp_Object console)
 {
   Lisp_Object device;
 allocate_device (Lisp_Object console)
 {
   Lisp_Object device;

-  struct device *d = alloc_lcrecord_type (struct device, lrecord_device);
+  struct device *d = alloc_lcrecord_type (struct device, &lrecord_device);

   struct gcpro gcpro1;
 
   zero_lcrecord (d);
   struct gcpro gcpro1;
 
   zero_lcrecord (d);

@@ -228,9 +227,9 @@ DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /*
 Given a device, frame, or window, return the associated device.
 Return nil otherwise.
 */
 Given a device, frame, or window, return the associated device.
 Return nil otherwise.
 */

-       (obj))
+       (object))

 {
 {

-  return DFW_DEVICE (obj);
+  return DFW_DEVICE (object);

 }
 
 \f
 }
 
 \f

@@ -387,16 +386,24 @@ static Lisp_Object
 semi_canonicalize_device_connection (struct console_methods *meths,
                                     Lisp_Object name, Error_behavior errb)
 {
 semi_canonicalize_device_connection (struct console_methods *meths,
                                     Lisp_Object name, Error_behavior errb)
 {

-  return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection,
-                               (name, errb), name);
+  if (HAS_CONTYPE_METH_P (meths, semi_canonicalize_device_connection))
+    return CONTYPE_METH (meths, semi_canonicalize_device_connection,
+                        (name, errb));
+  else
+    return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection,
+                                 (name, errb), name);

 }
 
 static Lisp_Object
 canonicalize_device_connection (struct console_methods *meths,
                                Lisp_Object name, Error_behavior errb)
 {
 }
 
 static Lisp_Object
 canonicalize_device_connection (struct console_methods *meths,
                                Lisp_Object name, Error_behavior errb)
 {

-  return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection,
-                               (name, errb), name);
+  if (HAS_CONTYPE_METH_P (meths, canonicalize_device_connection))
+    return CONTYPE_METH (meths, canonicalize_device_connection,
+                        (name, errb));
+  else
+    return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection,
+                                 (name, errb), name);

 }
 
 static Lisp_Object
 }
 
 static Lisp_Object

@@ -542,6 +549,9 @@ have no effect.
      device-independence violations occur in faces.el. */
   int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx);
 #endif
      device-independence violations occur in faces.el. */
   int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx);
 #endif

+#ifdef HAVE_GTK
+  int first_gtk_device = NILP (Vdefault_gtk_device) && EQ (type, Qgtk);
+#endif

 
   GCPRO3 (device, console, name);
 
 
   GCPRO3 (device, console, name);
 

@@ -591,6 +601,10 @@ have no effect.
   if (first_x_device)
     init_global_resources (d);
 #endif
   if (first_x_device)
     init_global_resources (d);
 #endif

+#ifdef HAVE_GTK
+  if (first_gtk_device)
+    init_global_resources (d);
+#endif

   init_device_resources (d);
 
   MAYBE_DEVMETH (d, finish_init_device, (d, props));
   init_device_resources (d);
 
   MAYBE_DEVMETH (d, finish_init_device, (d, props));

@@ -751,7 +765,8 @@ delete_device_internal (struct device *d, int force,
 
     /* #### This should probably be a device method but it is time for
        19.14 to go out the door. */
 
     /* #### This should probably be a device method but it is time for
        19.14 to go out the door. */

-#ifdef HAVE_X_WINDOWS
+    /* #### BILL!!! Should this deal with HAVE_MSWINDOWS as well? */
+#if defined (HAVE_X_WINDOWS) || defined (HAVE_GTK)

     /* Next delete all frames which have the popup property to avoid
        deleting a child after its parent. */
     DEVICE_FRAME_LOOP (frmcons, d)
     /* Next delete all frames which have the popup property to avoid
        deleting a child after its parent. */
     DEVICE_FRAME_LOOP (frmcons, d)

@@ -884,6 +899,7 @@ behavior cannot necessarily be determined automatically.
          MARK_FRAME_GLYPHS_CHANGED (f);
          MARK_FRAME_SUBWINDOWS_CHANGED (f);
          MARK_FRAME_TOOLBARS_CHANGED (f);
          MARK_FRAME_GLYPHS_CHANGED (f);
          MARK_FRAME_SUBWINDOWS_CHANGED (f);
          MARK_FRAME_TOOLBARS_CHANGED (f);

+         MARK_FRAME_GUTTERS_CHANGED (f);

          f->menubar_changed = 1;
        }
     }
          f->menubar_changed = 1;
        }
     }

@@ -912,6 +928,15 @@ Return the output baud rate of DEVICE.
   return make_int (DEVICE_BAUD_RATE (decode_device (device)));
 }
 
   return make_int (DEVICE_BAUD_RATE (decode_device (device)));
 }
 

+DEFUN ("device-printer-p", Fdevice_printer_p, 0, 1, 0, /*
+Return t if DEVICE is a printer, nil if it is a display. DEVICE defaults
+to selected device if omitted, and must be live if specified.
+*/
+       (device))
+{
+  return DEVICE_PRINTER_P (decode_device (device)) ? Qt : Qnil;
+}
+

 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
 Get a metric for DEVICE as provided by the system.
 
 DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /*
 Get a metric for DEVICE as provided by the system.
 

@@ -967,11 +992,14 @@ size-toolbar-button   Toolbar button size.
 size-toolbar-border   Toolbar border width and height.
 size-icon             Icon dimensions.
 size-icon-small       Small icon dimensions.
 size-toolbar-border   Toolbar border width and height.
 size-icon             Icon dimensions.
 size-icon-small       Small icon dimensions.

-size-device           Device screen size in pixels.
-size-workspace        Workspace size in pixels. This can be less than the
-                      above if window manager has decorations which
-                      effectively shrink the area remaining for application
-                      windows.
+size-device           Device screen or paper size in pixels.
+size-workspace        Workspace size in pixels. This can be less than or
+                      equal to the above. For displays, this is the area
+                      available to applications less window manager
+                      decorations. For printers, this is the size of
+                      printable area.
+offset-workspace      Offset of workspace area from the top left corner
+                      of screen or paper, in pixels.

 size-device-mm        Device screen size in millimeters.
 device-dpi            Device resolution, in dots per inch.
 num-bit-planes        Integer, number of device bit planes.
 size-device-mm        Device screen size in millimeters.
 device-dpi            Device resolution, in dots per inch.
 num-bit-planes        Integer, number of device bit planes.

@@ -1028,6 +1056,7 @@ security              Non-zero if user environment is secure.
   FROB (size_icon_small);
   FROB (size_device);
   FROB (size_workspace);
   FROB (size_icon_small);
   FROB (size_device);
   FROB (size_workspace);

+  FROB (offset_workspace);

   FROB (size_device_mm);
   FROB (device_dpi);
   FROB (num_bit_planes);
   FROB (size_device_mm);
   FROB (device_dpi);
   FROB (num_bit_planes);

@@ -1090,6 +1119,7 @@ DEVICE defaults to selected device when omitted.
   FROB (size_icon_small);
   FROB (size_device);
   FROB (size_workspace);
   FROB (size_icon_small);
   FROB (size_device);
   FROB (size_workspace);

+  FROB (offset_workspace);

   FROB (size_device_mm);
   FROB (device_dpi);
   FROB (num_bit_planes);
   FROB (size_device_mm);
   FROB (device_dpi);
   FROB (num_bit_planes);

@@ -1145,8 +1175,7 @@ window_system_pixelated_geometry (Lisp_Object domain)
   Lisp_Object winsy = domain_device_type (domain);
   struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT);
   assert (meth);
   Lisp_Object winsy = domain_device_type (domain);
   struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT);
   assert (meth);

-  return (MAYBE_INT_CONTYPE_METH (meth, device_implementation_flags, ())
-         & XDEVIMPF_PIXEL_GEOMETRY);
+  return CONMETH_IMPL_FLAG (meth, XDEVIMPF_PIXEL_GEOMETRY);

 }
 
 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /*
 }
 
 DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /*

@@ -1178,12 +1207,12 @@ handle_asynch_device_change (void)
   /* reset the flag to 0 unless another notification occurred while
      we were processing this one.  Block SIGWINCH during this
      check to prevent a possible race condition. */
   /* reset the flag to 0 unless another notification occurred while
      we were processing this one.  Block SIGWINCH during this
      check to prevent a possible race condition. */

-#ifndef WINDOWSNT
+#ifdef SIGWINCH

   EMACS_BLOCK_SIGNAL (SIGWINCH);
 #endif
   if (old_asynch_device_change_pending == asynch_device_change_pending)
     asynch_device_change_pending = 0;
   EMACS_BLOCK_SIGNAL (SIGWINCH);
 #endif
   if (old_asynch_device_change_pending == asynch_device_change_pending)
     asynch_device_change_pending = 0;

-#ifndef WINDOWSNT
+#ifdef SIGWINCH

   EMACS_UNBLOCK_SIGNAL (SIGWINCH);
 #endif
 }
   EMACS_UNBLOCK_SIGNAL (SIGWINCH);
 #endif
 }

@@ -1223,6 +1252,8 @@ call_critical_lisp_code (struct device *d, Lisp_Object function,
 void
 syms_of_device (void)
 {
 void
 syms_of_device (void)
 {

+  INIT_LRECORD_IMPLEMENTATION (device);
+

   DEFSUBR (Fvalid_device_class_p);
   DEFSUBR (Fdevice_class_list);
 
   DEFSUBR (Fvalid_device_class_p);
   DEFSUBR (Fdevice_class_list);
 

@@ -1247,10 +1278,10 @@ syms_of_device (void)
   DEFSUBR (Fset_device_baud_rate);
   DEFSUBR (Fdevice_baud_rate);
   DEFSUBR (Fdomain_device_type);
   DEFSUBR (Fset_device_baud_rate);
   DEFSUBR (Fdevice_baud_rate);
   DEFSUBR (Fdomain_device_type);

+  DEFSUBR (Fdevice_printer_p);

 
   defsymbol (&Qdevicep, "devicep");
   defsymbol (&Qdevice_live_p, "device-live-p");
 
   defsymbol (&Qdevicep, "devicep");
   defsymbol (&Qdevice_live_p, "device-live-p");

-  defsymbol (&Qdelete_device, "delete-device");

 
   defsymbol (&Qcreate_device_hook, "create-device-hook");
   defsymbol (&Qdelete_device_hook, "delete-device-hook");
 
   defsymbol (&Qcreate_device_hook, "create-device-hook");
   defsymbol (&Qdelete_device_hook, "delete-device-hook");

@@ -1287,6 +1318,7 @@ syms_of_device (void)
   defsymbol (&Qsize_icon_small, "size-icon-small");
   defsymbol (&Qsize_device, "size-device");
   defsymbol (&Qsize_workspace, "size-workspace");
   defsymbol (&Qsize_icon_small, "size-icon-small");
   defsymbol (&Qsize_device, "size-device");
   defsymbol (&Qsize_workspace, "size-workspace");

+  defsymbol (&Qoffset_workspace, "offset-workspace");

   defsymbol (&Qsize_device_mm, "size-device-mm");
   defsymbol (&Qnum_bit_planes, "num-bit-planes");
   defsymbol (&Qnum_color_cells, "num-color-cells");
   defsymbol (&Qsize_device_mm, "size-device-mm");
   defsymbol (&Qnum_bit_planes, "num-bit-planes");
   defsymbol (&Qnum_color_cells, "num-color-cells");

@@ -1299,8 +1331,18 @@ syms_of_device (void)
 }
 
 void
 }
 
 void

+reinit_vars_of_device (void)
+{
+  staticpro_nodump (&Vdefault_device);
+  Vdefault_device = Qnil;
+  asynch_device_change_pending = 0;
+}
+
+void

 vars_of_device (void)
 {
 vars_of_device (void)
 {

+  reinit_vars_of_device ();
+

   DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /*
 Function or functions to call when a device is created.
 One argument, the newly-created device.
   DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /*
 Function or functions to call when a device is created.
 One argument, the newly-created device.

@@ -1316,11 +1358,6 @@ One argument, the to-be-deleted device.
 */ );
   Vdelete_device_hook = Qnil;
 
 */ );
   Vdelete_device_hook = Qnil;
 

-  staticpro (&Vdefault_device);
-  Vdefault_device = Qnil;
-
-  asynch_device_change_pending = 0;
-

   Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono);
   staticpro (&Vdevice_class_list);
 
   Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono);
   staticpro (&Vdevice_class_list);