changeset 15235:440d937a60f7

(QCLIPBOARD): New symbol. (Fx_selection_exists_p): New function. (syms_of_win32select): Initialize/staticpro and defsubr them.
author Karl Heuer <kwzh@gnu.org>
date Tue, 14 May 1996 19:01:53 +0000
parents 2af580000f27
children 99d01b1b8799
files src/w32select.c
diffstat 1 files changed, 43 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/src/w32select.c	Tue May 14 17:44:15 1996 +0000
+++ b/src/w32select.c	Tue May 14 19:01:53 1996 +0000
@@ -27,6 +27,8 @@
 #include "frame.h"	/* Need this to get the X window of selected_frame */
 #include "blockinput.h"
 
+Lisp_Object QCLIPBOARD;
+
 #if 0
 DEFUN ("win32-open-clipboard", Fwin32_open_clipboard, Swin32_open_clipboard, 0, 1, 0,
        "This opens the clipboard with the given frame pointer.")
@@ -243,6 +245,44 @@
   return (ret);
 }
 
+/* Support checking for a clipboard selection. */
+
+DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
+  0, 1, 0,
+  "Whether there is an owner for the given X Selection.\n\
+The arg should be the name of the selection in question, typically one of\n\
+the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
+\(Those are literal upper-case symbol names, since that's what X expects.)\n\
+For convenience, the symbol nil is the same as `PRIMARY',\n\
+and t is the same as `SECONDARY'.")
+  (selection)
+     Lisp_Object selection;
+{
+  CHECK_SYMBOL (selection, 0);
+
+  /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
+     if the clipboard currently has valid text format contents. */
+
+  if (EQ (selection, QCLIPBOARD))
+    {
+      Lisp_Object val = Qnil;
+
+      if (OpenClipboard (NULL))
+	{
+	  int format = 0;
+	  while (format = EnumClipboardFormats (format))
+	    if (format == CF_TEXT)
+	      {
+		val = Qt;
+		break;
+	      }
+	  CloseClipboard ();
+	}
+      return val;
+    }
+  return Qnil;
+}
+
 void 
 syms_of_win32select ()
 {
@@ -253,4 +293,7 @@
 #endif
   defsubr (&Swin32_set_clipboard_data);
   defsubr (&Swin32_get_clipboard_data);
+  defsubr (&Sx_selection_exists_p);
+
+  QCLIPBOARD = intern ("CLIPBOARD");	staticpro (&QCLIPBOARD);
 }