import xemacs-21.2.37
[chise/xemacs-chise.git.1] / src / device.c
index a6b751f..16c10a6 100644 (file)
@@ -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
@@ -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
@@ -884,6 +891,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 +920,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 +984,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 +1048,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 +1111,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);
@@ -1178,12 +1200,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 +1245,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 +1271,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 +1311,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 +1324,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 +1351,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);