-/* x_handle_selection_notify
-x_reply_selection_request
-XFree
-x_selection_timeout initial value */
-
/* X Selection processing for emacs
- Copyright (C) 1990-1993 Free Software Foundation.
+ Copyright (C) 1993 Free Software Foundation.
This file is part of GNU Emacs.
along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+/* x_handle_selection_notify
+x_reply_selection_request */
+
+
/* Rewritten by jwz */
#include "config.h"
#include "xterm.h" /* for all of the X includes */
#include "dispextern.h" /* frame.h seems to want this */
#include "frame.h" /* Need this to get the X window of selected_frame */
+#include "blockinput.h"
#define xfree free
*/
#define MAX_SELECTION_QUANTUM 0xFFFFFF
-#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
-
+#ifdef HAVE_X11R4
+#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
+#else
+#define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
+#endif
/* The timestamp of the last input event Emacs received from the X server. */
unsigned long last_event_timestamp;
Lisp_Object Vselection_converter_alist;
/* If the selection owner takes too long to reply to a selection request,
- we give up on it. This is in seconds (0 = no timeout.)
+ we give up on it. This is in milliseconds (0 = no timeout.)
*/
int x_selection_timeout;
UNBLOCK_INPUT;
return val;
}
-
-
-static Lisp_Object
-long_to_cons (i)
- unsigned long i;
-{
- unsigned int top = i >> 16;
- unsigned int bot = i & 0xFFFF;
- if (top == 0) return make_number (bot);
- if (top == 0xFFFF) return Fcons (make_number (-1), make_number (bot));
- return Fcons (make_number (top), make_number (bot));
-}
-
-static unsigned long
-cons_to_long (c)
- Lisp_Object c;
-{
- int top, bot;
- if (INTEGERP (c)) return XINT (c);
- top = XCONS (c)->car;
- bot = XCONS (c)->cdr;
- if (CONSP (bot)) bot = XCONS (bot)->car;
- return ((XINT (top) << 16) | XINT (bot));
-}
-
-
\f
/* Do protocol to assert ourself as a selection owner.
Update the Vselection_alist so that we can reply to later requests for
CHECK_SYMBOL (target_type, 0);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
- if (NILP (handler_fn)) return Qnil;
- value = call3 (handler_fn,
- selection_symbol, target_type,
- XCONS (XCONS (local_value)->cdr)->car);
+ if (!NILP (handler_fn))
+ value = call3 (handler_fn,
+ selection_symbol, target_type,
+ XCONS (XCONS (local_value)->cdr)->car);
+ else
+ value = Qnil;
unbind_to (count, Qnil);
}
/* Make sure this value is of a type that we could transmit
to another X client. */
+
check = value;
if (CONSP (value)
&& SYMBOLP (XCONS (value)->car))
|| INTEGERP (check)
|| NILP (value))
return value;
+ /* Check for a value that cons_to_long could handle. */
else if (CONSP (check)
&& INTEGERP (XCONS (check)->car)
&& (INTEGERP (XCONS (check)->cdr)
else
return
Fsignal (Qerror,
- Fcons (build_string ("unrecognised selection-conversion type"),
+ Fcons (build_string ("invalid data returned by selection-conversion function"),
Fcons (handler_fn, Fcons (value, Qnil))));
}
\f
XChangeProperty (display, window, reply.property, type, format,
PropModeReplace, data, 0);
}
+ XFlushQueue ();
UNBLOCK_INPUT;
}
\f
Atom target_property = Xatom_EMACS_TMP;
Atom selection_atom = symbol_to_x_atom (display, selection_symbol);
Atom type_atom;
+ int secs, usecs;
if (CONSP (target_type))
type_atom = symbol_to_x_atom (display, XCONS (target_type)->car);
BLOCK_INPUT;
XConvertSelection (display, selection_atom, type_atom, target_property,
requestor_window, requestor_time);
+ XFlushQueue ();
/* Prepare to block until the reply has been read. */
reading_selection_window = requestor_window;
XCONS (reading_selection_reply)->car = Qnil;
UNBLOCK_INPUT;
- /* This allows quits. */
- wait_reading_process_input (x_selection_timeout, 0,
- reading_selection_reply, 0);
+ /* This allows quits. Also, don't wait forever. */
+ secs = x_selection_timeout / 1000;
+ usecs = (x_selection_timeout % 1000) * 1000;
+ wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
if (NILP (XCONS (reading_selection_reply)->car))
error ("timed out waiting for reply from selection owner");
(*(short **) data_ret) [0] = (short) XINT (obj);
if (NILP (type)) type = QINTEGER;
}
- else if (INTEGERP (obj) || CONSP (obj))
+ else if (INTEGERP (obj)
+ || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
+ && (INTEGERP (XCONS (obj)->cdr)
+ || (CONSP (XCONS (obj)->cdr)
+ && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
{
*format_ret = 32;
*size_ret = 1;
TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names, since that's what X expects.)\n\
VALUE is typically a string, or a cons of two markers, but may be\n\
-anything that the functions on selection-converter-alist know about.")
+anything that the functions on `selection-converter-alist' know about.")
(selection_name, selection_value)
Lisp_Object selection_name, selection_value;
{
"Return text selected from some X window.\n\
SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
\(Those are literal upper-case symbol names, since that's what X expects.)\n\
-TYPE is the type of data desired, typically STRING.")
+TYPE is the type of data desired, typically `STRING'.")
(selection_symbol, target_type)
Lisp_Object selection_symbol, target_type;
{
DEFUN ("x-disown-selection-internal",
Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
- "If we own the named selection, then disown it (make there be no selection).")
+ "If we own the selection SELECTION, disown it.\n\
+Disowning it means there is no such selection.")
(selection, time)
Lisp_Object selection;
Lisp_Object time;
XSetSelectionOwner (display, selection_atom, None, timestamp);
UNBLOCK_INPUT;
- /* It doesn't seem to be guarenteed that a SelectionClear event will be
+ /* It doesn't seem to be guaranteed that a SelectionClear event will be
generated for a window which owns the selection when that window sets
the selection owner to None. The NCD server does, the MIT Sun4 server
doesn't. So we synthesize one; this means we might get two, but
return Qt;
}
+/* Get rid of all the selections in buffer BUFFER.
+ This is used when we kill a buffer. */
+
+void
+x_disown_buffer_selections (buffer)
+ Lisp_Object buffer;
+{
+ Lisp_Object tail;
+ struct buffer *buf = XBUFFER (buffer);
+
+ for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
+ {
+ Lisp_Object elt, value;
+ elt = XCONS (tail)->car;
+ value = XCONS (elt)->cdr;
+ if (CONSP (value) && MARKERP (XCONS (value)->car)
+ && XMARKER (XCONS (value)->car)->buffer == buf)
+ Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
+ }
+}
DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
0, 1, 0,
- "Whether the current emacs process owns the given X Selection.\n\
+ "Whether the current Emacs process owns 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\
Lisp_Object selection;
{
Window owner;
+ Atom atom;
Display *dpy = x_current_display;
CHECK_SYMBOL (selection, 0);
if (!NILP (Fx_selection_owner_p (selection)))
return Qt;
+ if (EQ (selection, Qnil)) selection = QPRIMARY;
+ if (EQ (selection, Qt)) selection = QSECONDARY;
+ atom = symbol_to_x_atom (dpy, selection);
+ if (atom == 0)
+ return Qnil;
BLOCK_INPUT;
- owner = XGetSelectionOwner (dpy, symbol_to_x_atom (dpy, selection));
+ owner = XGetSelectionOwner (dpy, atom);
UNBLOCK_INPUT;
return (owner ? Qt : Qnil);
}
}
-#define CHECK_CUTBUFFER(symbol,n) \
+#define CHECK_CUT_BUFFER(symbol,n) \
{ CHECK_SYMBOL ((symbol), (n)); \
if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
&& !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
&& !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
&& !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
Fsignal (Qerror, \
- Fcons (build_string ("doesn't name a cutbuffer"), \
+ Fcons (build_string ("doesn't name a cut buffer"), \
Fcons ((symbol), Qnil))); \
}
-DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal,
- Sx_get_cutbuffer_internal, 1, 1, 0,
- "Returns the value of the named cutbuffer (typically CUT_BUFFER0).")
+DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
+ Sx_get_cut_buffer_internal, 1, 1, 0,
+ "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
(buffer)
Lisp_Object buffer;
{
Display *display = x_current_display;
- Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
+ Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
Atom buffer_atom;
unsigned char *data;
int bytes;
unsigned long size;
Lisp_Object ret;
- CHECK_CUTBUFFER (buffer, 0);
+ CHECK_CUT_BUFFER (buffer, 0);
buffer_atom = symbol_to_x_atom (display, buffer);
x_get_window_property (display, window, buffer_atom, &data, &bytes,
}
-DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal,
- Sx_store_cutbuffer_internal, 2, 2, 0,
- "Sets the value of the named cutbuffer (typically CUT_BUFFER0).")
+DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
+ Sx_store_cut_buffer_internal, 2, 2, 0,
+ "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
(buffer, string)
Lisp_Object buffer, string;
{
Display *display = x_current_display;
- Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
+ Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
Atom buffer_atom;
unsigned char *data;
int bytes;
int max_bytes = SELECTION_QUANTUM (display);
if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
- CHECK_CUTBUFFER (buffer, 0);
+ CHECK_CUT_BUFFER (buffer, 0);
CHECK_STRING (string, 0);
buffer_atom = symbol_to_x_atom (display, buffer);
data = (unsigned char *) XSTRING (string)->data;
if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
BLOCK_INPUT;
+
+ /* Don't mess up with an empty value. */
+ if (!bytes_remaining)
+ XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
+ PropModeReplace, data, 0);
+
while (bytes_remaining)
{
int chunk = (bytes_remaining < max_bytes
}
-DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal,
- Sx_rotate_cutbuffers_internal, 1, 1, 0,
- "Rotate the values of the cutbuffers by the given number of steps;\n\
+DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
+ Sx_rotate_cut_buffers_internal, 1, 1, 0,
+ "Rotate the values of the cut buffers by the given number of steps;\n\
positive means move values forward, negative means backward.")
(n)
Lisp_Object n;
{
Display *display = x_current_display;
- Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
+ Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
Atom props [8];
CHECK_NUMBER (n, 0);
void
syms_of_xselect ()
{
- atoms_of_xselect ();
-
defsubr (&Sx_get_selection_internal);
defsubr (&Sx_own_selection_internal);
defsubr (&Sx_disown_selection_internal);
defsubr (&Sx_selection_exists_p);
#ifdef CUT_BUFFER_SUPPORT
- defsubr (&Sx_get_cutbuffer_internal);
- defsubr (&Sx_store_cutbuffer_internal);
- defsubr (&Sx_rotate_cutbuffers_internal);
+ defsubr (&Sx_get_cut_buffer_internal);
+ defsubr (&Sx_store_cut_buffer_internal);
+ defsubr (&Sx_rotate_cut_buffers_internal);
cut_buffers_initialized = 0;
#endif
Vx_sent_selection_hooks = Qnil;
DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
- "Number of seconds to wait for a selection reply from another X client.\n\
-If the selection owner doens't reply in this many seconds, we give up.\n\
+ "Number of milliseconds to wait for a selection reply.\n\
+If the selection owner doens't reply in this time, we give up.\n\
A value of 0 means wait as long as necessary. This is initialized from the\n\
-\"*selectionTimeout\" resource (which is expressed in milliseconds).");
+\"*selectionTimeout\" resource.");
x_selection_timeout = 0;
QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
HCoop / bpt / emacs.git / blobdiff