[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Drag and drop patch for X, please review.
|
From: |
Jan D. |
|
Subject: |
Drag and drop patch for X, please review. |
|
Date: |
Sat, 17 Jan 2004 17:35:19 +0100 (CET) |
Hello.
The enclosed patch adds drag and drop support (well, actually only drop)
in X to Emacs. The protocols supported are XDND (the most used nowdays,
by Mozilla, OpenOffice, Gnome, KDE etc.) and the old KDE 1.x protocol.
You can currently drop file names and text. Files will be opened
and text inserted (at mouse position). Http urls and such are just
ignored, probably there is something more intelligent one could do,
suggestions?
The reason to include the old KDE one is that it is very simple and
easy to test.
I plan to add Motif and OpenWindows as soon as I get Solaris 8 & 9 installed
(waiting for an ordered disc drive).
I previously did this in C, but it added so much code and the turnaround time
for modifications where long, so this implementation is mostly in elisp.
As elisp is not one of my better known languages, any comments and
improvements are welcome.
There are some issues with file names with non-ascii characters in them,
part of that is due to the fact that XDND is not very clear on how that
should be done, and KDE and Gnome does things differently.
Also, I am not sure if I got it right either.
Thanks,
Jan D.
Index: lisp/term/x-win.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/term/x-win.el,v
retrieving revision 1.166
diff -c -c -r1.166 x-win.el
*** lisp/term/x-win.el 1 Sep 2003 15:45:36 -0000 1.166
--- lisp/term/x-win.el 17 Jan 2004 16:18:11 -0000
***************
*** 76,81 ****
--- 76,82 ----
(require 'select)
(require 'menu-bar)
(require 'fontset)
+ (require 'x-dnd)
(defvar x-invocation-args)
***************
*** 2455,2460 ****
--- 2456,2465 ----
;; Turn on support for mouse wheels.
(mouse-wheel-mode 1)
+
+ ;; Initiate drag and drop
+ (add-hook 'after-make-frame-functions 'x-dnd-init-frame)
+ (global-set-key [drag-n-drop] 'x-dnd-handle-drag-n-drop-event)
;;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78
;;; x-win.el ends here
Index: src/xfns.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xfns.c,v
retrieving revision 1.601
diff -c -c -r1.601 xfns.c
*** src/xfns.c 28 Dec 2003 00:13:10 -0000 1.601
--- src/xfns.c 17 Jan 2004 16:18:19 -0000
***************
*** 4284,4408 ****
/***********************************************************************
- General X functions exposed to Elisp.
- ***********************************************************************/
-
- DEFUN ("x-send-client-message", Fx_send_client_event,
- Sx_send_client_message, 6, 6, 0,
- doc: /* Send a client message of MESSAGE-TYPE to window DEST on
DISPLAY.
-
- For DISPLAY, specify either a frame or a display name (a string).
- If DISPLAY is nil, that stands for the selected frame's display.
- DEST may be an integer, in which case it is a Window id. The value 0 may
- be used to send to the root window of the DISPLAY.
- If DEST is a frame the event is sent to the outer window of that frame.
- Nil means the currently selected frame.
- If DEST is the string "PointerWindow" the event is sent to the window that
- contains the pointer. If DEST is the string "InputFocus" the event is
- sent to the window that has the input focus.
- FROM is the frame sending the event. Use nil for currently selected frame.
- MESSAGE-TYPE is the name of an Atom as a string.
- FORMAT must be one of 8, 16 or 32 and determines the size of the values in
- bits. VALUES is a list of integer and/or strings containing the values to
- send. If a value is a string, it is converted to an Atom and the value of
- the Atom is sent. If more values than fits into the event is given,
- the excessive values are ignored. */)
- (display, dest, from, message_type, format, values)
- Lisp_Object display, dest, from, message_type, format, values;
- {
- struct x_display_info *dpyinfo = check_x_display_info (display);
- Window wdest;
- XEvent event;
- Lisp_Object cons;
- int i;
- int max_nr_values = (int) sizeof (event.xclient.data.b);
- struct frame *f = check_x_frame (from);
-
- CHECK_STRING (message_type);
- CHECK_NUMBER (format);
- CHECK_CONS (values);
-
- for (cons = values; CONSP (cons); cons = XCDR (cons))
- {
- Lisp_Object o = XCAR (cons);
-
- if (! INTEGERP (o) && ! STRINGP (o))
- error ("Bad data in VALUES, must be integer or string");
- }
-
- event.xclient.type = ClientMessage;
- event.xclient.format = XFASTINT (format);
-
- if (event.xclient.format != 8 && event.xclient.format != 16
- && event.xclient.format != 32)
- error ("FORMAT must be one of 8, 16 or 32");
- if (event.xclient.format == 16) max_nr_values /= 2;
- if (event.xclient.format == 32) max_nr_values /= 4;
-
- if (FRAMEP (dest) || NILP (dest))
- {
- struct frame *fdest = check_x_frame (dest);
- wdest = FRAME_OUTER_WINDOW (fdest);
- }
- else if (STRINGP (dest))
- {
- if (strcmp (SDATA (dest), "PointerWindow") == 0)
- wdest = PointerWindow;
- else if (strcmp (SDATA (dest), "InputFocus") == 0)
- wdest = InputFocus;
- else
- error ("DEST as a string must be one of PointerWindow or InputFocus");
- }
- else
- {
- CHECK_NUMBER (dest);
- wdest = (Window) XFASTINT (dest);
- if (wdest == 0) wdest = dpyinfo->root_window;
- }
-
- BLOCK_INPUT;
- for (cons = values, i = 0;
- CONSP (cons) && i < max_nr_values;
- cons = XCDR (cons), ++i)
- {
- Lisp_Object o = XCAR (cons);
- long val;
-
- if (INTEGERP (o))
- val = XINT (o);
- else if (STRINGP (o))
- val = XInternAtom (dpyinfo->display, SDATA (o), False);
-
- if (event.xclient.format == 8)
- event.xclient.data.b[i] = (char) val;
- else if (event.xclient.format == 16)
- event.xclient.data.s[i] = (short) val;
- else
- event.xclient.data.l[i] = val;
- }
-
- for ( ; i < max_nr_values; ++i)
- if (event.xclient.format == 8)
- event.xclient.data.b[i] = 0;
- else if (event.xclient.format == 16)
- event.xclient.data.s[i] = 0;
- else
- event.xclient.data.l[i] = 0;
-
- event.xclient.message_type
- = XInternAtom (dpyinfo->display, SDATA (message_type), False);
- event.xclient.display = dpyinfo->display;
- event.xclient.window = FRAME_OUTER_WINDOW (f);
-
- XSendEvent (dpyinfo->display, wdest, False, 0xffff, &event);
-
- XFlush (dpyinfo->display);
- UNBLOCK_INPUT;
-
- return Qnil;
- }
-
- /***********************************************************************
Image types
***********************************************************************/
--- 4284,4289 ----
***************
*** 9593,9616 ****
***********************************************************************/
DEFUN ("x-change-window-property", Fx_change_window_property,
! Sx_change_window_property, 2, 3, 0,
doc: /* Change window property PROP to VALUE on the X window of FRAME.
! PROP and VALUE must be strings. FRAME nil or omitted means use the
! selected frame. Value is VALUE. */)
! (prop, value, frame)
! Lisp_Object frame, prop, value;
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
CHECK_STRING (prop);
! CHECK_STRING (value);
BLOCK_INPUT;
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
! XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
! prop_atom, XA_STRING, 8, PropModeReplace,
! SDATA (value), SCHARS (value));
/* Make sure the property is set when we return. */
XFlush (FRAME_X_DISPLAY (f));
--- 9474,9559 ----
***********************************************************************/
DEFUN ("x-change-window-property", Fx_change_window_property,
! Sx_change_window_property, 2, 6, 0,
doc: /* Change window property PROP to VALUE on the X window of FRAME.
! PROP must be a string.
! VALUE may be a string or a list of conses, numbers and/or strings.
! If an element in the list is a string, it is converted to
! an Atom and the value of the Atom is used. If an element is a cons,
! it is converted to a 32 bit number where the car is the 16 top bits and the
! cdr is the lower 16 bits.
! FRAME nil or omitted means use the selected frame.
! If TYPE is given and non-nil, it is the name of the type of VALUE.
! If TYPE is not given or nil, the type is STRING.
! FORMAT gives the size in bits of each element if VALUE is a list.
! It must be one of 8, 16 or 32.
! If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8.
! If OUTER_P is non-nil, the property is changed for the outer X window of
! FRAME. Default is to change on the edit X window.
!
! Value is VALUE. */)
! (prop, value, frame, type, format, outer_p)
! Lisp_Object frame, prop, value, outer_p;
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
+ Atom target_type = XA_STRING;
+ int element_format = 8;
+ unsigned char *data;
+ int nelements;
+ Lisp_Object cons;
+ Window w;
CHECK_STRING (prop);
!
! if (! NILP (format))
! {
! CHECK_NUMBER (format);
! element_format = XFASTINT (format);
!
! if (element_format != 8 && element_format != 16
! && element_format != 32)
! error ("FORMAT must be one of 8, 16 or 32");
! }
!
! if (CONSP (value))
! {
! nelements = x_check_property_data (value);
! if (nelements == -1)
! error ("Bad data in VALUE, must be number, string or cons");
!
! if (element_format == 8)
! data = (unsigned char *) xmalloc (nelements);
! else if (element_format == 16)
! data = (unsigned char *) xmalloc (nelements*2);
! else
! data = (unsigned char *) xmalloc (nelements*4);
!
! x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format);
! }
! else
! {
! CHECK_STRING (value);
! data = SDATA (value);
! nelements = SCHARS (value);
! }
BLOCK_INPUT;
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
! if (! NILP (type))
! {
! CHECK_STRING (type);
! target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
! }
!
! if (! NILP (outer_p)) w = FRAME_OUTER_WINDOW (f);
! else w = FRAME_X_WINDOW (f);
!
! XChangeProperty (FRAME_X_DISPLAY (f), w,
! prop_atom, target_type, element_format, PropModeReplace,
! data, nelements);
!
! if (CONSP (value)) xfree (data);
/* Make sure the property is set when we return. */
XFlush (FRAME_X_DISPLAY (f));
***************
*** 9644,9656 ****
DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
! 1, 2, 0,
doc: /* Value is the value of window property PROP on FRAME.
! If FRAME is nil or omitted, use the selected frame. Value is nil
! if FRAME hasn't a property with name PROP or if PROP has no string
! value. */)
! (prop, frame)
! Lisp_Object prop, frame;
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
--- 9587,9606 ----
DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
! 1, 6, 0,
doc: /* Value is the value of window property PROP on FRAME.
! If FRAME is nil or omitted, use the selected frame.
! If TYPE is nil or omitted, get the property as a string. Otherwise TYPE
! is the name of the Atom that denotes the type expected.
! If SOURCE is non-nil, get the property on that window instead of form
! FRAME. The number 0 denotes the root window.
! If DELETE_P is non-nil, delete the property after retreiving it.
! If VECTOR_RET_P is non-nil, don't return a string but a vector of values.
!
! Value is nil if FRAME hasn't a property with name PROP or if PROP has
! no value of TYPE. */)
! (prop, frame, type, source, delete_p, vector_ret_p)
! Lisp_Object prop, frame, type, source, delete_p, vector_ret_p;
{
struct frame *f = check_x_frame (frame);
Atom prop_atom;
***************
*** 9658,9671 ****
Lisp_Object prop_value = Qnil;
char *tmp_data = NULL;
Atom actual_type;
int actual_format;
unsigned long actual_size, bytes_remaining;
CHECK_STRING (prop);
BLOCK_INPUT;
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
! rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
! prop_atom, 0, 0, False, XA_STRING,
&actual_type, &actual_format, &actual_size,
&bytes_remaining, (unsigned char **) &tmp_data);
if (rc == Success)
--- 9608,9650 ----
Lisp_Object prop_value = Qnil;
char *tmp_data = NULL;
Atom actual_type;
+ Atom target_type = XA_STRING;
int actual_format;
unsigned long actual_size, bytes_remaining;
+ Window target_window = FRAME_X_WINDOW (f);
+ struct gcpro gcpro1;
+ GCPRO1 (prop_value);
CHECK_STRING (prop);
+
+ if (! NILP (source))
+ {
+ if (NUMBERP (source))
+ {
+ if (FLOATP (source))
+ target_window = (Window) XFLOAT (source);
+ else
+ target_window = XFASTINT (source);
+
+ if (target_window == 0)
+ target_window = FRAME_X_DISPLAY_INFO (f)->root_window;
+ }
+ else if (CONSP (source))
+ target_window = cons_to_long (source);
+ }
+
BLOCK_INPUT;
+ if (STRINGP (type))
+ {
+ if (strcmp ("AnyPropertyType", SDATA (type)) == 0)
+ target_type = AnyPropertyType;
+ else
+ target_type = XInternAtom (FRAME_X_DISPLAY (f), SDATA (type), False);
+ }
+
prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SDATA (prop), False);
! rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
! prop_atom, 0, 0, False, target_type,
&actual_type, &actual_format, &actual_size,
&bytes_remaining, (unsigned char **) &tmp_data);
if (rc == Success)
***************
*** 9675,9693 ****
XFree (tmp_data);
tmp_data = NULL;
! rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
prop_atom, 0, bytes_remaining,
! False, XA_STRING,
&actual_type, &actual_format,
&actual_size, &bytes_remaining,
(unsigned char **) &tmp_data);
if (rc == Success && tmp_data)
! prop_value = make_string (tmp_data, size);
! XFree (tmp_data);
}
UNBLOCK_INPUT;
return prop_value;
}
--- 9654,9682 ----
XFree (tmp_data);
tmp_data = NULL;
! rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window,
prop_atom, 0, bytes_remaining,
! ! NILP (delete_p), target_type,
&actual_type, &actual_format,
&actual_size, &bytes_remaining,
(unsigned char **) &tmp_data);
if (rc == Success && tmp_data)
! {
! if (NILP (vector_ret_p))
! prop_value = make_string (tmp_data, size);
! else
! prop_value = x_property_data_to_lisp (f,
! (unsigned char *) tmp_data,
! actual_type,
! actual_format,
! actual_size);
! }
! if (tmp_data) XFree (tmp_data);
}
UNBLOCK_INPUT;
+ UNGCPRO;
return prop_value;
}
***************
*** 11097,11103 ****
defsubr (&Sx_close_connection);
defsubr (&Sx_display_list);
defsubr (&Sx_synchronize);
- defsubr (&Sx_send_client_message);
defsubr (&Sx_focus_frame);
defsubr (&Sx_backspace_delete_keys_p);
--- 11086,11091 ----
Index: src/xselect.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xselect.c,v
retrieving revision 1.130
diff -c -c -r1.130 xselect.c
*** src/xselect.c 1 Sep 2003 15:45:58 -0000 1.130
--- src/xselect.c 17 Jan 2004 16:18:21 -0000
***************
*** 30,35 ****
--- 30,38 ----
#include "blockinput.h"
#include "buffer.h"
#include "process.h"
+ #include "termhooks.h"
+
+ #include <X11/Xproto.h>
struct prop_location;
***************
*** 2278,2283 ****
--- 2281,2640 ----
#endif
+ /***********************************************************************
+ Drag and drop support
+ ***********************************************************************/
+ /* Check that lisp values are of correct type for x_fill_property_data.
+ That is, number, string or a cons with two numbers (low and high 16
+ bit parts of a 32 bit number). */
+ int
+ x_check_property_data (data)
+ Lisp_Object data;
+ {
+ Lisp_Object iter;
+ int size = 0;
+
+ for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size)
+ {
+ Lisp_Object o = XCAR (iter);
+
+ if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
+ size = -1;
+ else if (CONSP (o) &&
+ (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
+ size = -1;
+ }
+
+ return size;
+ }
+
+ /* Convert lisp values to a C array. Values may be a number, a string
+ which is taken as an X atom name and converted to the atom value, or
+ a cons containing the two 16 bit parts of a 32 bit number.
+
+ DPY is the display use to look up X atoms.
+ DATA is a Lisp list of values to be converted.
+ RET is the C array that contains the converted values. It is assumed
+ it is big enough to hol all values.
+ FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
+ be stored in RET. */
+
+ void
+ x_fill_property_data (dpy, data, ret, format)
+ Display *dpy;
+ Lisp_Object data;
+ void *ret;
+ int format;
+ {
+ CARD32 val;
+ CARD32 *d32 = (CARD32 *) ret;
+ CARD16 *d16 = (CARD16 *) ret;
+ CARD8 *d08 = (CARD8 *) ret;
+ Lisp_Object iter;
+
+ for (iter = data; CONSP (iter); iter = XCDR (iter))
+ {
+ Lisp_Object o = XCAR (iter);
+
+ if (INTEGERP (o))
+ val = (CARD32) XFASTINT (o);
+ else if (FLOATP (o))
+ val = (CARD32) XFLOAT (o);
+ else if (CONSP (o))
+ val = (CARD32) cons_to_long (o);
+ else if (STRINGP (o))
+ {
+ BLOCK_INPUT;
+ val = XInternAtom (dpy, (char *) SDATA (o), False);
+ UNBLOCK_INPUT;
+ }
+ else
+ error ("Wrong type, must be string, number or cons");
+
+ if (format == 8)
+ *d08++ = (CARD8) val;
+ else if (format == 16)
+ *d16++ = (CARD16) val;
+ else
+ *d32++ = val;
+ }
+ }
+
+ /* Convert an array of C values to a Lisp list.
+ F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
+ DATA is a C array of values to be converted.
+ TYPE is the type of the data. Only XA_ATOM is special, it converts
+ each number in DATA to its corresponfing X atom as a symbol.
+ FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
+ be stored in RET.
+ SIZE is the number of elements in DATA.
+
+ Also see comment for selection_data_to_lisp_data above. */
+
+ Lisp_Object
+ x_property_data_to_lisp (f, data, type, format, size)
+ struct frame *f;
+ unsigned char *data;
+ Atom type;
+ int format;
+ unsigned long size;
+ {
+ return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
+ data, size*format/8, type, format);
+ }
+
+ /* Get the mouse position in frame relative coordinates. */
+ static void
+ mouse_position_for_drop (f, x, y)
+ FRAME_PTR f;
+ int *x;
+ int *y;
+ {
+ Window root, dummy_window;
+ int dummy;
+
+ BLOCK_INPUT;
+
+ XQueryPointer (FRAME_X_DISPLAY (f),
+ DefaultRootWindow (FRAME_X_DISPLAY (f)),
+
+ /* The root window which contains the pointer. */
+ &root,
+
+ /* Window pointer is on, not used */
+ &dummy_window,
+
+ /* The position on that root window. */
+ x, y,
+
+ /* x/y in dummy_window coordinates, not used. */
+ &dummy, &dummy,
+
+ /* Modifier keys and pointer buttons, about which
+ we don't care. */
+ (unsigned int *) &dummy);
+
+
+ /* Absolute to relative. */
+ *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
+ *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
+
+ UNBLOCK_INPUT;
+ }
+
+ DEFUN ("x-get-atom-name", Fx_get_atom_name,
+ Sx_get_atom_name, 1, 2, 0,
+ doc: /* Return the X atom name as a string for VALUE.
+ VALUE may be a number or a cons where the car is the lower 16 bits and
+ the cdr is the upper 16 bits of a 32 bit value.
+ Use the display for FRAME or the current frame if FRAME is not given or nil.
+
+ If the value is 0 or the atom is not known, return the empty string. */)
+ (value, frame)
+ Lisp_Object value, frame;
+ {
+ struct frame *f = check_x_frame (frame);
+ char *name = 0;
+ Lisp_Object ret = Qnil;
+ int count;
+ Display *dpy = FRAME_X_DISPLAY (f);
+ Atom atom;
+
+ if (INTEGERP (value))
+ atom = (Atom) XUINT (value);
+ else if (FLOATP (value))
+ atom = (Atom) XFLOAT (value);
+ else if (CONSP (value))
+ atom = (Atom) cons_to_long (value);
+ else
+ error ("Wrong type, value must be number or cons");
+
+ BLOCK_INPUT;
+ count = x_catch_errors (dpy);
+
+ name = atom ? XGetAtomName (dpy, atom) : "";
+
+ if (! x_had_errors_p (dpy))
+ ret = make_string (name, strlen (name));
+
+ x_uncatch_errors (dpy, count);
+
+ if (atom && name) XFree (name);
+ if (NILP (ret)) ret = make_string ("", 0);
+
+ UNBLOCK_INPUT;
+
+ return ret;
+ }
+
+ /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
+ TODO: Check if this client event really is a DND event? */
+ int
+ x_handle_dnd_message (f, event, dpyinfo, bufp)
+ struct frame *f;
+ XClientMessageEvent *event;
+ struct x_display_info *dpyinfo;
+ struct input_event *bufp;
+ {
+ Lisp_Object vec;
+ Lisp_Object frame;
+ unsigned long size = (8*sizeof (event->data))/event->format;
+ int x, y;
+
+ XSETFRAME (frame, f);
+
+ vec = Fmake_vector (4, Qnil);
+ AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
+ event->message_type));
+ AREF (vec, 1) = frame;
+ AREF (vec, 2) = XFASTINT (event->format);
+ AREF (vec, 3) = x_property_data_to_lisp (f,
+ event->data.b,
+ event->message_type,
+ event->format,
+ size);
+
+ mouse_position_for_drop (f, &x, &y);
+ bufp->kind = DRAG_N_DROP_EVENT;
+ bufp->frame_or_window = Fcons (frame, vec);
+ bufp->timestamp = CurrentTime;
+ bufp->x = make_number (x);
+ bufp->y = make_number (y);
+ bufp->arg = Qnil;
+ bufp->modifiers = 0;
+
+ return 1;
+ }
+
+ DEFUN ("x-send-client-message", Fx_send_client_event,
+ Sx_send_client_message, 6, 6, 0,
+ doc: /* Send a client message of MESSAGE-TYPE to window DEST on
DISPLAY.
+
+ For DISPLAY, specify either a frame or a display name (a string).
+ If DISPLAY is nil, that stands for the selected frame's display.
+ DEST may be a number, in which case it is a Window id. The value 0 may
+ be used to send to the root window of the DISPLAY.
+ If DEST is a cons, it is converted to a 32 bit number
+ with the high 16 bits from the car and the lower 16 bit from the cdr. That
+ number is then used as a window id.
+ If DEST is a frame the event is sent to the outer window of that frame.
+ Nil means the currently selected frame.
+ If DEST is the string "PointerWindow" the event is sent to the window that
+ contains the pointer. If DEST is the string "InputFocus" the event is
+ sent to the window that has the input focus.
+ FROM is the frame sending the event. Use nil for currently selected frame.
+ MESSAGE-TYPE is the name of an Atom as a string.
+ FORMAT must be one of 8, 16 or 32 and determines the size of the values in
+ bits. VALUES is a list of numbers, cons and/or strings containing the values
+ to send. If a value is a string, it is converted to an Atom and the value of
+ the Atom is sent. If a value is a cons, it is converted to a 32 bit number
+ with the high 16 bits from the car and the lower 16 bit from the cdr.
+ If more values than fits into the event is given, the excessive values
+ are ignored. */)
+ (display, dest, from, message_type, format, values)
+ Lisp_Object display, dest, from, message_type, format, values;
+ {
+ struct x_display_info *dpyinfo = check_x_display_info (display);
+ Window wdest;
+ XEvent event;
+ Lisp_Object cons;
+ int size;
+ struct frame *f = check_x_frame (from);
+ int count;
+ int to_root;
+
+ CHECK_STRING (message_type);
+ CHECK_NUMBER (format);
+ CHECK_CONS (values);
+
+ if (x_check_property_data (values) == -1)
+ error ("Bad data in VALUES, must be number, cons or string");
+
+ event.xclient.type = ClientMessage;
+ event.xclient.format = XFASTINT (format);
+
+ if (event.xclient.format != 8 && event.xclient.format != 16
+ && event.xclient.format != 32)
+ error ("FORMAT must be one of 8, 16 or 32");
+
+ if (FRAMEP (dest) || NILP (dest))
+ {
+ struct frame *fdest = check_x_frame (dest);
+ wdest = FRAME_OUTER_WINDOW (fdest);
+ }
+ else if (STRINGP (dest))
+ {
+ if (strcmp (SDATA (dest), "PointerWindow") == 0)
+ wdest = PointerWindow;
+ else if (strcmp (SDATA (dest), "InputFocus") == 0)
+ wdest = InputFocus;
+ else
+ error ("DEST as a string must be one of PointerWindow or InputFocus");
+ }
+ else if (INTEGERP (dest))
+ wdest = (Window) XFASTINT (dest);
+ else if (FLOATP (dest))
+ wdest = (Window) XFLOAT (dest);
+ else if (CONSP (dest))
+ {
+ if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
+ error ("Both car and cdr for DEST must be numbers");
+ else
+ wdest = (Window) cons_to_long (dest);
+ }
+ else
+ error ("DEST must be a frame, nil, string, number or cons");
+
+ if (wdest == 0) wdest = dpyinfo->root_window;
+ to_root = wdest == dpyinfo->root_window;
+
+ for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size)
+ ;
+
+ BLOCK_INPUT;
+
+ event.xclient.message_type
+ = XInternAtom (dpyinfo->display, SDATA (message_type), False);
+ event.xclient.display = dpyinfo->display;
+
+ /* Some clients (metacity for example) expects sending window to be here
+ when sending to the root window. */
+ event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
+ memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
+
+ x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
+ event.xclient.format);
+
+ /* If event mask is 0 the event is sent to the client that created
+ the destination window. But if we are sending to the root window,
+ there is no such client. Then we set the event mask to 0xffff. The
+ event then goes to clients selecting for events on the root window. */
+ count = x_catch_errors (dpyinfo->display);
+ {
+ int propagate = to_root ? False : True;
+ unsigned mask = to_root ? 0xffff : 0;
+ XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
+ }
+
+ XFlush (dpyinfo->display);
+ x_uncatch_errors (dpyinfo->display, count);
+ UNBLOCK_INPUT;
+
+ #if 0
+ fprintf(stderr, "XSend: dest 0x%x, type %d format %d "
+ "[0x%x 0x%x 0x%x 0x%x 0x%x]\n",
+ wdest, event.xclient.message_type, event.xclient.format,
+ event.xclient.data.l[0],
+ event.xclient.data.l[1],
+ event.xclient.data.l[2],
+ event.xclient.data.l[3],
+ event.xclient.data.l[4]);
+ #endif
+
+ return Qnil;
+ }
+
+
void
syms_of_xselect ()
{
***************
*** 2292,2297 ****
--- 2649,2657 ----
defsubr (&Sx_store_cut_buffer_internal);
defsubr (&Sx_rotate_cut_buffers_internal);
#endif
+
+ defsubr (&Sx_get_atom_name);
+ defsubr (&Sx_send_client_message);
reading_selection_reply = Fcons (Qnil, Qnil);
staticpro (&reading_selection_reply);
Index: src/xterm.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xterm.c,v
retrieving revision 1.825
diff -c -c -r1.825 xterm.c
*** src/xterm.c 16 Jan 2004 18:47:40 -0000 1.825
--- src/xterm.c 17 Jan 2004 16:18:31 -0000
***************
*** 5934,5940 ****
}
#endif /* USE_TOOLKIT_SCROLL_BARS */
else
! goto OTHER;
}
break;
--- 5934,5958 ----
}
#endif /* USE_TOOLKIT_SCROLL_BARS */
else
! {
! struct frame *f
! = x_any_window_to_frame (dpyinfo, event.xclient.window);
!
! if (f)
! {
! int ret = x_handle_dnd_message (f, &event.xclient,
! dpyinfo, bufp);
! if (ret > 0)
! {
! ++bufp, ++count, --numchars;
! }
!
! if (ret != 0)
! *finish = X_EVENT_DROP;
! }
! else
! goto OTHER;
! }
}
break;
Index: src/xterm.h
===================================================================
RCS file: /cvsroot/emacs/emacs/src/xterm.h,v
retrieving revision 1.156
diff -c -c -r1.156 xterm.h
*** src/xterm.h 16 Nov 2003 16:05:21 -0000 1.156
--- src/xterm.h 17 Jan 2004 16:18:31 -0000
***************
*** 1006,1013 ****
--- 1006,1029 ----
extern void x_handle_selection_clear P_ ((struct input_event *));
extern void x_clear_frame_selections P_ ((struct frame *));
+ extern int x_handle_dnd_message P_ ((struct frame *,
+ XClientMessageEvent *,
+ struct x_display_info *,
+ struct input_event *bufp));
+ extern int x_check_property_data P_ ((Lisp_Object));
+ extern void x_fill_property_data P_ ((Display *,
+ Lisp_Object,
+ void *,
+ int));
+ extern Lisp_Object x_property_data_to_lisp P_ ((struct frame *,
+ unsigned char *,
+ Atom,
+ int,
+ unsigned long));
+
/* Defined in xfns.c */
+ extern struct x_display_info * check_x_display_info P_ ((Lisp_Object frame));
extern int have_menus_p P_ ((void));
extern int x_bitmap_height P_ ((struct frame *, int));
extern int x_bitmap_width P_ ((struct frame *, int));
*** /dev/null 1970-01-01 01:00:00.000000000 +0100
--- lisp/x-dnd.el 2004-01-17 16:38:43.000000000 +0100
***************
*** 0 ****
--- 1,310 ----
+
+ (defvar x-dnd-debug nil
+ "Set to non-nil to get debugging messages from X drag and drop code.")
+
+ (defvar x-dnd-current-type nil
+ "The type (Atom name) we want the DND data to be in for the current drop.
+ TODO: There should be one of these per display. How to do that?")
+
+ (defun x-dnd-debug (string &rest args)
+ "If x-dnd-debug is non-nil, call message with STRING and ARGS."
+ (if x-dnd-debug (message "%s" (apply 'format string args))))
+
+
+ (defun x-dnd-init-frame (&optional frame)
+ "Setup drag and drop for FRAME (i.e. create appropriate properties)."
+ (x-dnd-init-xdnd-for-frame frame))
+
+ (defun x-dnd-handle-one-drop (arg &optional split_p)
+ "Opens ARG if it is a file. If not a file, do nothing.
+ If SPLIT_P is non-nil, split the window before opening the file."
+ (x-dnd-debug "DND: %s" arg)
+ (let* ((uri (replace-regexp-in-string
+ "%[A-Z0-9][A-Z0-9]"
+ (lambda (arg)
+ (format "%c" (string-to-number (substring arg 1) 16)))
+ arg))
+ (f (cond ((string-match "^file:///" uri) ;; XDND format.
+ (substring uri (1- (match-end 0))))
+ ((string-match "^file://" uri) ;; URI with host
+ nil) ;; Skip for now.
+ ((string-match "^file:" uri) ;; Old KDE, Motif, Sun
+ (substring uri (match-end 0)))
+ ((string-match "^[a-z]+://" uri) ;; http:// and such.
+ (progn ;; Ignore other URI:s for now.
+ (message "DND: ignoring '%s'" uri)
+ nil))
+
+ (t (error "Bad URI ignored: %s" uri)))))
+ (if f
+ (let* ((decoded-f (decode-coding-string
+ f
+ (or file-name-coding-system
+ default-file-name-coding-system)))
+ (try-f (if (file-readable-p decoded-f) decoded-f f)))
+ (if (file-readable-p try-f)
+ (progn
+ (if split_p (split-window))
+ (find-file try-f))
+ (error "Can not read %s (%s)" try-f f))))))
+
+ (defvar x-dnd-known-types
+ '(("text/uri-list" 6)
+ ("text/x-moz-url" 5 nil xdnd-handle-moz-url)
+ ("FILE_NAME" 4)
+ ("_NETSCAPE_URL" 3)
+ ("UTF8_STRING" 2 t xdnd-decode-utf8)
+ ("text/plain;charset=UTF-8" 2 t xdnd-decode-utf8)
+ ("text/plain;charset=utf-8" 2 t xdnd-decode-utf8)
+ ("STRING" 1 t)
+ ("TEXT" 1 t)
+ ("text/plain" 1 t)
+ )
+ "The types accepted for dropped data.
+ The list elements are: type order is-text special-handling-function")
+
+ (defun xdnd-decode-utf8 (data type)
+ "Decode DATA that is in utf-8 format."
+ (x-dnd-debug "decode-utf8: '%s' %s'" data type)
+ (decode-coding-string data 'utf-8))
+
+ (defun xdnd-handle-moz-url (data type)
+ "Handle one item of type text/x-moz-url, returning just the URL.
+ DATA is the moz-url, which is formatted as two strings separated by \r\n.
+ The first string is the URL, the second string is the title of that URL.
+ DATA is encoded in utf-16."
+ (let* ((string (decode-coding-string data 'utf-16le)) ;; ALWAYS LE???
+ (strings (split-string string "[\r\n]" t))
+ ;; Can one drop more than one moz-url ?? Assume not.
+ (url (car strings))
+ (title (car (cdr strings))))
+ (setq last-moz data)
+ (set-text-properties 0 (length url)
+ (list 'original-url string 'title title)
+ url)
+ url))
+
+ (defun x-dnd-type-is-text (type)
+ "Return t if TYPE is defined as a text type in `x-dnd-known-types'."
+ (let ((type-info (assoc type x-dnd-known-types)))
+ (and type-info (nth 2 type-info))))
+
+ (defun x-dnd-choose-type (types)
+ "Choose which type we want to receive for the drop.
+ TYPES are the types the source of the drop offers. Select among these
+ according to `x-dnd-known-types' and return that type name. If no suitable
+ type is found, return nil."
+ (x-dnd-debug "DND types: %s" types)
+ (let ((w -1)
+ (pref nil))
+ (dotimes (i (length types))
+ (let* ((type (aref types i))
+ (typename (if (stringp type) type
+ (symbol-name type)))
+ (typeinfo (assoc typename x-dnd-known-types))
+ (weight (if typeinfo (nth 1 typeinfo)
+ -1)))
+ (if (and (> weight 0) (> weight w))
+ (setq w weight pref typename))))
+ pref))
+
+ (defun x-dnd-drop-data (event frame data type)
+ "Drop one data item onto a frame.
+ EVENT is the client message for the drop, FRAME is the frame the drop occurred
+ on. DATA is the data received from the source, and type is the type
+ for DATA (see `x-dnd-known-types').
+
+ Return t if drop was successful, nil if not."
+ (let* ((type-info (assoc type x-dnd-known-types))
+ (preprocess (nth 3 type-info))
+ (dropvalue (if preprocess
+ (funcall preprocess data type)
+ data))
+ (w (posn-window (event-start event))))
+ (if (x-dnd-type-is-text type)
+ (let* ((buffer (window-buffer w)))
+ (progn
+ (select-window w)
+ (set-buffer buffer)
+ (barf-if-buffer-read-only)
+ (goto-char (posn-point (event-start event)))
+ (insert (replace-regexp-in-string "\0$" "" dropvalue))
+ t)
+ nil)
+ (progn ;; Dropping URL:s
+ (select-frame frame)
+ (when (windowp w) (select-window w))
+ (x-dnd-handle-uri-list dropvalue)
+ t))))
+
+ (defun x-dnd-handle-uri-list (string)
+ "Split an uri-list into separate URIs and call `x-dnd-handle-one-drop'.
+ STRING is the uri-list as a string. The URIs are separated by \r\n."
+ (let ((uri-list (split-string string "[\0\r\n]" t)))
+ (mapcar 'x-dnd-handle-one-drop uri-list)))
+
+ (defun x-dnd-handle-drag-n-drop-event (event)
+ "Receive drag and drop events (X client messages).
+ Currently XDND and old KDE 1.x protocols are recognized.
+ TODO: Add Motif and OpenWindows."
+ (interactive "e")
+ (let* ((client-message (car (cdr (cdr event))))
+ (window (posn-window (event-start event)))
+ (message-atom (aref client-message 0))
+ (frame (aref client-message 1))
+ (format (aref client-message 2))
+ (data (aref client-message 3)))
+
+ (cond ((equal "DndProtocol" message-atom) ;; Old KDE 1.x.
+ (x-dnd-handle-old-kde event frame message-atom format data))
+
+ ((and (> (length message-atom) 4) ;; XDND protocol.
+ (equal "Xdnd" (substring message-atom 0 4)))
+ (x-dnd-handle-xdnd event frame message-atom format data))
+
+ (t (error "Unknown DND atom: %s" message-atom)))))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; Old KDE protocol. Only dropping of files.
+
+ (defun x-dnd-handle-old-kde (event frame message format data)
+ "Open the files in a KDE 1.x drop."
+ (let ((values (x-window-property "DndSelection" frame nil 0 t)))
+ (x-dnd-handle-uri-list (replace-regexp-in-string "\0$" "" values))))
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; XDND protocol.
+
+ (defun x-dnd-init-xdnd-for-frame (frame)
+ "Set the XdndAware for FRAME to indicate that we do XDND."
+ (x-change-window-property "XdndAware"
+ '(5) ;; The version of XDND we support.
+ frame "ATOM" 32 t))
+
+ (defun x-dnd-get-drop-width-height (frame w accept)
+ "Return the widht/height to be sent in a XDndStatus message.
+ FRAME is the frame and W is the window where the drop happened.
+ If ACCEPT is nil return 0 (empty rectangle),
+ otherwise if W is a window, return its widht/height,
+ otherwise return the frame width/height."
+ (if accept
+ (if (windowp w) ;; w is not a window if dropping on the menu bar,
+ ;; scroll bar or tool bar.
+ (let ((edges (window-inside-pixel-edges w)))
+ (cons
+ (- (nth 2 edges) (nth 0 edges)) ;; right - left
+ (- (nth 3 edges) (nth 1 edges)))) ;; bottom - top
+ (cons (frame-pixel-width frame)
+ (frame-pixel-height frame)))
+ 0))
+
+ (defun x-dnd-get-drop-x-y (frame w)
+ "Return the x/y coordinates to be sent in a XDndStatus message.
+ Coordinates are required to be absolute.
+ FRAME is the frame and W is the window where the drop happened.
+ If W is a window, return its absolute corrdinates,
+ otherwise return the frame coordinates."
+ (let* ((frame-left (frame-parameter frame 'left))
+ ;; If the frame is outside the display, frame-left looks like
+ ;; '(0 -16). Extract the -16.
+ (frame-real-left (if (consp frame-left) (car (cdr frame-left))
+ frame-left))
+ (frame-top (frame-parameter frame 'top))
+ (frame-real-top (if (consp frame-top) (car (cdr frame-top))
+ frame-top)))
+ (if (windowp w)
+ (let ((edges (window-inside-pixel-edges w)))
+ (cons
+ (+ frame-real-left (nth 0 edges))
+ (+ frame-real-top (nth 1 edges))))
+ (cons frame-real-left frame-real-top))))
+
+ (defun x-dnd-handle-xdnd (event frame message format data)
+ "Receive one XDND event (client message) and send the appropriate reply.
+ EVENT is the client message. FRAME is where the mouse is now.
+ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
+ (x-dnd-debug "Xdnd: %s %s %s" message format data)
+ (cond ((equal "XdndEnter" message)
+ (let ((version (ash (car (aref data 1)) -8))
+ (more-than-3 (cdr (aref data 1)))
+ (dnd-source (aref data 0)))
+ (setq x-dnd-current-type
+ (x-dnd-choose-type
+ (if (> more-than-3 0)
+ (x-window-property "XdndTypeList"
+ frame "AnyPropertyType"
+ dnd-source nil t)
+ (vector (x-get-atom-name (aref data 2))
+ (x-get-atom-name (aref data 3))
+ (x-get-atom-name (aref data 4))))))
+ (x-dnd-debug "Version %s, more-than-3 %s, dnd-source %s pref %s"
+ version more-than-3 dnd-source x-dnd-current-type)))
+
+ ((equal "XdndPosition" message)
+ (let* ((x (car (aref data 2)))
+ (y (cdr (aref data 2)))
+ (action (x-get-atom-name (aref data 4)))
+ (dnd-source (aref data 0))
+ (dnd-time (aref data 3))
+ (w (posn-window (event-start event)))
+ (accept ;; 1 = accept, 0 = reject
+ ;; Reject if dropping text and the mouse is not over
+ ;; a window (i.e. menu bar or scroll bar) or
+ ;; mouse is over a read only buffer.
+ (if (x-dnd-type-is-text x-dnd-current-type)
+ (if (and (windowp w)
+ (window-live-p w)
+ (not (buffer-local-value
+ 'buffer-read-only
+ (window-buffer w))))
+ 1
+ 0)
+ 1))
+ (list-to-send
+ (list (string-to-number
+ (frame-parameter frame 'outer-window-id))
+ accept ;; 1 = Accept, 0 = reject.
+ (x-dnd-get-drop-x-y frame w)
+ (x-dnd-get-drop-width-height frame w (eq accept 1))
+ "XdndActionPrivate" ;; Always use private.
+ )))
+ (x-send-client-message
+ frame dnd-source frame "XdndStatus" 32 list-to-send)
+ (x-dnd-debug "Status %s" list-to-send)
+ ))
+
+ ((equal "XdndLeave" message)
+ (setq x-dnd-current-type nil)
+ (x-dnd-debug "Leave %s" data))
+
+ ((equal "XdndDrop" message)
+ (let* ((dnd-source (aref data 0))
+ (value (and x-dnd-current-type
+ (x-get-selection-internal
+ 'XdndSelection
+ (intern x-dnd-current-type))))
+ (success
+ (if (and value
+ (condition-case nil
+ (x-dnd-drop-data event frame value
+ x-dnd-current-type)
+ (error nil)))
+ 1
+ 0)))
+ (x-dnd-debug "Drop success %s" success)
+ (x-send-client-message
+ frame dnd-source frame "XdndFinished" 32
+ (list (string-to-number (frame-parameter frame 'outer-window-id))
+ success ;; 1 = Success, 0 = Error
+ (if success "XdndActionPrivate" 0)
+ ))
+ (setq x-dnd-current-type nil)))
+
+ (t (error "Unknown XDND message %s %s" message data))))
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ (provide 'x-dnd)