Changeset 3088

Timestamp:

05/28/03 20:17:20 (6 years ago)

Author:

himi

Message:

(Fmw32_get_device_capability): New function.
(syms_of_mw32term): do defsubr() for mw32-get-device-capability.

Files:

• work/cvs2svn/src/mw32term.c (modified) (2 diffs)

work/cvs2svn/src/mw32term.c

@@ -10708 +10708 @@
-}
-
+DEFUN ("mw32-get-device-capability",
+       Fmw32_get_device_capability,
+       Smw32_get_device_capability,
+       1, 2, 0, 
+"Retrieve system metrics. This function only calls GetSystemMetrics.")
+  (item, target)
+{
+  HDC hdc;
+  Lisp_Object ret;
+
+  if (EQ (target, Qnil))
+    {
+      hdc = FRAME_HDC (SELECTED_FRAME ());
+    }
+  else if (FRAMEP (target))
+    {
+      hdc = FRAME_HDC (XFRAME (target));
+    }
+  else
+    {
+      Fsignal (Qwrong_type_argument,
+               Fcons (build_string ("Currently, target must be frame or nil."),
+                      Fcons (item, Qnil)));
+    }
+
+  if (EQ (item, intern ("width-in-mm")))
+    {
+      int val = GetDeviceCaps (hdc, HORZSIZE);
+      XSETINT (ret, val);
+    }
+  else if (EQ (item, intern ("height-in-mm")))
+    {
+      int val = GetDeviceCaps (hdc, VERTSIZE);
+      XSETINT (ret, val);
+    }
+  else if (EQ (item, intern ("width")))
+    {
+      int val = GetDeviceCaps (hdc, HORZRES);
+      XSETINT (ret, val);
+    }
+  else if (EQ (item, intern ("height")))
+    {
+      int val = GetDeviceCaps (hdc, VERTRES);
+      XSETINT (ret, val);
+    }
+  else if (EQ (item, intern ("pixel-width-in-mm")))
+    {
+      int val = GetDeviceCaps (hdc, LOGPIXELSX);
+      ret = make_float (25.4 / val);
+    }
+  else if (EQ (item, intern ("pixel-height-in-mm")))
+    {
+      int val = GetDeviceCaps (hdc, LOGPIXELSY);
+      ret = make_float (25.4 / val);
+    }
+  else if (EQ (item, intern ("color-bits")))
+    {
+      int val = (GetDeviceCaps (hdc, BITSPIXEL)
+                 * GetDeviceCaps (hdc, PLANES));
+      XSETINT (ret, val);
+    }
+  else if (EQ (item, intern ("colors")))
+    {
+      int val = GetDeviceCaps (hdc, NUMCOLORS);
+      if (val == -1)
+        ret = intern ("full");
+      else
+        XSETINT (ret, val);
+    }
+  else if (EQ (item, intern ("clipping")))
+    {
+      int val = GetDeviceCaps (hdc, CLIPCAPS);
+      if (val)
+        ret = Qt;
+      else
+        ret = Qnil;
+    }
+  else if (EQ (item, intern ("text-capabilities")))
+    {
+      int val = GetDeviceCaps (hdc, TEXTCAPS);
+
+      ret = Qnil;
+      if (val & TC_OP_CHARACTER)
+        ret = Fcons(intern ("character"), ret);
+      if (val & TC_OP_STROKE)
+        ret = Fcons(intern ("stroke"), ret);
+      if (val & TC_CP_STROKE)
+        ret = Fcons(intern ("clipping"), ret);
+      if (val & TC_CR_90)
+        ret = Fcons(intern ("rotate-90"), ret);
+      if (val & TC_CR_ANY)
+        ret = Fcons(intern ("rotate"), ret);
+      if (val & TC_SA_DOUBLE)
+        ret = Fcons(intern ("scale"), ret);
+      if (val & TC_SA_INTEGER)
+        ret = Fcons(intern ("scale-in-integer"), ret);
+
+      if (val & TC_IA_ABLE)
+        ret = Fcons(intern ("italic"), ret);
+      if (val & TC_UA_ABLE)
+        ret = Fcons(intern ("underline"), ret);
+      if (val & TC_SO_ABLE)
+        ret = Fcons(intern ("strikeout"), ret);
+
+      if (val & TC_RA_ABLE)
+        ret = Fcons(intern ("raster"), ret);
+      if (val & TC_VA_ABLE)
+        ret = Fcons(intern ("vector"), ret);
+    }
+  else if (NUMBERP (item))
+    {
+      int val = GetDeviceCaps (hdc, XINT (item));
+      XSETINT (ret, val);
+    }
+  else
+    {
+      Fsignal (Qwrong_type_argument,
+               Fcons (build_string ("Invalid item."),
+                      Fcons (item, Qnil)));
+    }
+
+  return ret;
+}
+
-DEFUN ("Meadow-version",
-       FMeadow_version,
@@ -10777 +10901 @@
-  defsubr (&Sw32_get_mouse_wheel_scroll_lines);
-  defsubr (&Sw32_keyboard_type);
+  defsubr (&Smw32_get_device_capability);
-  defsubr (&SMeadow_version);
-}