annotate src/select-x.c @ 826:6728e641994e

[xemacs-hg @ 2002-05-05 11:30:15 by ben] syntax cache, 8-bit-format, lots of code cleanup README.packages: Update info about --package-path. i.c: Create an inheritable event and pass it on to XEmacs, so that ^C can be handled properly. Intercept ^C and signal the event. "Stop Build" in VC++ now works. bytecomp-runtime.el: Doc string changes. compat.el: Some attempts to redo this to make it truly useful and fix the "multiple versions interacting with each other" problem. Not yet done. Currently doesn't work. files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code. xemacs.mak: Split up CFLAGS into a version without flags specifying the C library. The problem seems to be that minitar depends on zlib, which depends specifically on libc.lib, not on any of the other C libraries. Unless you compile with libc.lib, you get errors -- specifically, no _errno in the other libraries, which must make it something other than an int. (#### But this doesn't seem to obtain in XEmacs, which also uses zlib, and can be linked with any of the C libraries. Maybe zlib is used differently and doesn't need errno, or maybe XEmacs provides an int errno; ... I don't understand. Makefile.in.in: Fix so that packages are around when testing. abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch. -- FUNCTIONALITY CHANGES: add partial support for 8-bit-fixed, 16-bit-fixed, and 32-bit-fixed formats. not quite done yet. (in particular, needs functions to actually convert the buffer.) NOTE: lots of changes to regex.c here. also, many new *_fmt() inline funs that take an Internal_Format argument. redo syntax cache code. make the cache per-buffer; keep the cache valid across calls to functions that use it. also keep it valid across insertions/deletions and extent changes, as much as is possible. eliminate the junky regex-reentrancy code by passing in the relevant lisp info to the regex routines as local vars. add general mechanism in extents code for signalling extent changes. fix numerous problems with the case-table implementation; yoshiki never properly transferred many algorithms from old-style to new-style case tables. redo char tables to support a default argument, so that mapping only occurs over changed args. change many chartab functions to accept Lisp_Object instead of Lisp_Char_Table *. comment out the code in font-lock.c by default, because font-lock.el no longer uses it. we should consider eliminating it entirely. Don't output bell as ^G in console-stream when not a TTY. add -mswindows-termination-handle to interface with i.c, so we can properly kill a build. add more error-checking to buffer/string macros. add some additional buffer_or_string_() funs. -- INTERFACE CHANGES AFFECTING MORE CODE: switch the arguments of write_c_string and friends to be consistent with write_fmt_string, which must have printcharfun first. change BI_* macros to BYTE_* for increased clarity; similarly for bi_* local vars. change VOID_TO_LISP to be a one-argument function. eliminate no-longer-needed CVOID_TO_LISP. -- char/string macro changes: rename MAKE_CHAR() to make_emchar() for slightly less confusion with make_char(). (The former generates an Emchar, the latter a Lisp object. Conceivably we should rename make_char() -> wrap_char() and similarly for make_int(), make_float().) Similar changes for other *CHAR* macros -- we now consistently use names with `emchar' whenever we are working with Emchars. Any remaining name with just `char' always refers to a Lisp object. rename macros with XSTRING_* to string_* except for those that reference actual fields in the Lisp_String object, following conventions used elsewhere. rename set_string_{data,length} macros (the only ones to work with a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_* to make the difference clear. try to be consistent about caps vs. lowercase in macro/inline-fun names for chars and such, which wasn't the case before. we now reserve caps either for XFOO_ macros that reference object fields (e.g. XSTRING_DATA) or for things that have non-function semantics, e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an arg (any arg) more than once. otherwise, use lowercase. here is a summary of most of the macros/inline funs changed by all of the above changes: BYTE_*_P -> byte_*_p XSTRING_BYTE -> string_byte set_string_data/length -> set_lispstringp_data/length XSTRING_CHAR_LENGTH -> string_char_length XSTRING_CHAR -> string_emchar INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p charptr_copy_char -> charptr_copy_emchar LEADING_BYTE_* -> leading_byte_* CHAR_* -> EMCHAR_* *_CHAR_* -> *_EMCHAR_* *_CHAR -> *_EMCHAR CHARSET_BY_ -> charset_by_* BYTE_SHIFT_JIS* -> byte_shift_jis* BYTE_BIG5* -> byte_big5* REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte char_to_unicode -> emchar_to_unicode valid_char_p -> valid_emchar_p Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality). -- INTERFACE CHANGES AFFECTING LESS CODE: use DECLARE_INLINE_HEADER in various places. remove '#ifdef emacs' from XEmacs-only files. eliminate CHAR_TABLE_VALUE(), which duplicated the functionality of get_char_table(). add BUFFER_TEXT_LOOP to simplify iterations over buffer text. define typedefs for signed and unsigned types of fixed sizes (INT_32_BIT, UINT_32_BIT, etc.). create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE; fix code to use it. add charptr_emchar_len to return the text length of the character pointed to by a ptr; use it in place of charcount_to_bytecount(..., 1). add emchar_len to return the text length of a given character. add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount and Charbpos/Charcount, in code (particularly, the extents code and redisplay code) that works with either kind of index. rename redisplay struct params with names such as `charbpos' to e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos. eliminate xxDEFUN in place of DEFUN; no longer necessary with changes awhile back to doc.c. split up big ugly combined list of EXFUNs in lisp.h on a file-by-file basis, since other prototypes are similarly split. rewrite some "*_UNSAFE" macros as inline funs and eliminate the _UNSAFE suffix. move most string code from lisp.h to text.h; the string code and text.h code is now intertwined in such a fashion that they need to be in the same place and partially interleaved. (you can't create forward references for inline funs) automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in batch mode. Fix up some problems in lisp-tests/symbol-tests that were causing spurious failures.
author ben
date Sun, 05 May 2002 11:33:57 +0000
parents a5954632b187
children 42375619fa45
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* X Selection processing for XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3 Copyright (C) 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not synched with FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Rewritten by jwz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
29 #include "charset.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
30 #include "device.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
31 #include "frame.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
32 #include "opaque.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
33 #include "select.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
34
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "console-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "objects-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 int lisp_to_time (Lisp_Object, time_t *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 Lisp_Object time_to_lisp (time_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #ifdef LWLIB_USES_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 # define MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #ifdef MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 # include <Xm/CutPaste.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 static void hack_motif_clipboard_selection (Atom selection_atom,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Lisp_Object selection_value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 Time thyme, Display *display,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
52 Window selecting_window,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
53 int owned_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #define CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object Vx_sent_selection_hooks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 /* If this is a smaller number than the max-request-size of the display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 emacs will use INCR selection transfer when the selection is larger
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 than this. The max-request-size is usually around 64k, so if you want
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 emacs to use incremental selection transfers when the selection is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 smaller than that, set this. I added this mostly for debugging the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 incremental transfer stuff, but it might improve server performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #define MAX_SELECTION_QUANTUM 0xFFFFFF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 /* If the selection owner takes too long to reply to a selection request,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 we give up on it. This is in seconds (0 = no timeout).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
79 Fixnum x_selection_timeout;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
81 /* Enable motif selection optimizations. */
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
82 int x_selection_strict_motif_ownership;
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
83
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 /* Utility functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 static Lisp_Object x_get_window_property_as_lisp_data (Display *,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 Lisp_Object target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 Atom selection_atom);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 static int expect_property_change (Display *, Window, Atom prop, int state);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 static void wait_for_property_change (long);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 static void unexpect_property_change (int);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 static int waiting_for_other_props_on_window (Display *, Window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 /* This converts a Lisp symbol to a server Atom, avoiding a server
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 roundtrip whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 static Atom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 if (NILP (sym)) return XA_PRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 if (EQ (sym, Qt)) return XA_SECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 if (EQ (sym, QSTRING)) return XA_STRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 if (EQ (sym, QINTEGER)) return XA_INTEGER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 if (EQ (sym, QATOM)) return XA_ATOM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
137 const Extbyte *nameext;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
138 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 return XInternAtom (display, nameext, only_if_exists ? True : False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 and calls to intern whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 x_atom_to_symbol (struct device *d, Atom atom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 if (! atom) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 if (atom == XA_PRIMARY) return QPRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 if (atom == XA_SECONDARY) return QSECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 if (atom == XA_STRING) return QSTRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 if (atom == XA_INTEGER) return QINTEGER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 if (atom == XA_ATOM) return QATOM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 if (atom == DEVICE_XATOM_INCR (d)) return QINCR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 if (atom == DEVICE_XATOM_NULL (d)) return QNULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
182 Intbyte *intstr;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
183 Extbyte *str = XGetAtomName (display, atom);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 if (! str) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
187 TO_INTERNAL_FORMAT (C_STRING, str,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
188 C_STRING_ALLOCA, intstr,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
189 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 XFree (str);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
191 return intern_int (intstr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
195 #define PROCESSING_X_CODE
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
196 #include "select-common.h"
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
197 #undef PROCESSING_X_CODE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 /* Do protocol to assert ourself as a selection owner.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
202 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
203 Lisp_Object how_to_add, Lisp_Object selection_type,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
204 int owned_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 struct frame *sel_frame = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 Lisp_Object selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 /* Use the time of the last-read mouse or keyboard event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 For selection purposes, we use this as a sleazy way of knowing what the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 current time is in server-time. This assumes that the most recently read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 mouse or keyboard event has something to do with the assertion of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 selection, which is probably true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Atom selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 CHECK_SYMBOL (selection_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 selection_atom = symbol_to_x_atom (d, selection_name, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 /* We do NOT use time_to_lisp() here any more, like we used to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 That assumed equivalence of time_t and Time, which is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 necessarily the case (e.g. under OSF on the Alphas, where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 Time is a 64-bit quantity and time_t is a 32-bit quantity).
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
229
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 Opaque pointers are the clean way to go here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
232 selection_time = make_opaque (&thyme, sizeof (thyme));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 #ifdef MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 hack_motif_clipboard_selection (selection_atom, selection_value,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
236 thyme, display, selecting_window, owned_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 return selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 static void motif_clipboard_cb ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 hack_motif_clipboard_selection (Atom selection_atom,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 Lisp_Object selection_value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 Time thyme,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 Display *display,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
252 Window selecting_window,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
253 int owned_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 /* Those Motif wankers can't be bothered to follow the ICCCM, and do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 their own non-Xlib non-Xt clipboard processing. So we have to do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 this so that linked-in Motif widgets don't get themselves wedged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 && STRINGP (selection_value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 /* If we already own the clipboard, don't own it again in the Motif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 way. This might lose in some subtle way, since the timestamp won't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 be current, but owning the selection on the Motif way does a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 SHITLOAD of X protocol, and it makes killing text be incredibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 slow when using an X terminal. ARRRRGGGHHH!!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 /* No, this is no good, because then Motif text fields don't bother
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 to look up the new value, and you can't Copy from a buffer, Paste
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 into a text field, then Copy something else from the buffer and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 paste it into the text field -- it pastes the first thing again. */
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
273 && (!owned_p
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
274 /* Selectively re-enable this because for most users its
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
275 just too painful - especially over a remote link. */
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
276 || x_selection_strict_motif_ownership)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 long itemid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 #if XmVersion >= 1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 long dataid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 XmString fmh;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 String encoding = "STRING";
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
290 const Intbyte *data = XSTRING_DATA (selection_value);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
291 Bytecount bytes = XSTRING_LENGTH (selection_value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
296 const Intbyte *ptr = data, *end = ptr + bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 /* Optimize for the common ASCII case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 while (ptr <= end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
300 if (byte_ascii_p (*ptr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (*ptr) == LEADING_BYTE_CONTROL_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 chartypes = LATIN_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 ptr += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 chartypes = WORLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 if (chartypes == LATIN_1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
319 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
320 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
321 Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 else if (chartypes == WORLD)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
324 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
325 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
326 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 encoding = "COMPOUND_TEXT";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 XmClipboardStartCopy (display, selecting_window, fmh, thyme,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 widget, motif_clipboard_cb,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 0, NULL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 &itemid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 XmStringFree (fmh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 XmClipboardCopy (display, selecting_window, itemid, encoding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 /* O'Reilly examples say size can be 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 but this clearly is not the case. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 0, bytes, (int) selecting_window, /* private id */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (XtPointer) data, bytes, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 &dataid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 XmClipboardEndCopy (display, selecting_window, itemid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 /* I tried to treat the clipboard like a real selection, and not send
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 the data until it was requested, but it looks like that just doesn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 work at all unless the selection owner and requestor are in different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 processes. From reading the Motif source, it looks like they never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 even considered having two widgets in the same application transfer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 data between each other using "by-name" clipboard values. What a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 bunch of fuckups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 switch (*reason)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 case XmCR_CLIPBOARD_DATA_REQUEST:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 Display *dpy = XtDisplay (widget);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 Window window = (Window) *private_id;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
378 Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
379
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
380 /* Whichever lazy git wrote this originally just called abort()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
381 when anything didn't go their way... */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
382
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
383 /* Try some other text types */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
384 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
385 selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
386 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
387 selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
388 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
389 selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
390
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
391 if (CONSP (selection) && SYMBOLP (XCAR (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
392 && (EQ (XCAR (selection), QSTRING)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
393 || EQ (XCAR (selection), QTEXT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
394 || EQ (XCAR (selection), QCOMPOUND_TEXT)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
395 selection = XCDR (selection);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
396
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
397 if (NILP (selection))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
398 signal_error (Qselection_conversion_error, "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
399 Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
400
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
401 if (!STRINGP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
402 signal_error (Qselection_conversion_error,
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
403 "couldn't convert selection to string", Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
404
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
405
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 XmClipboardCopyByName (dpy, window, *data_id,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (char *) XSTRING_DATA (selection),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 XSTRING_LENGTH (selection) + 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 case XmCR_CLIPBOARD_DATA_DELETE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 /* don't need to free anything */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 #endif /* MOTIF_CLIPBOARDS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 /* Send a SelectionNotify event to the requestor with property=None, meaning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 we were unable to do what they wanted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 x_decline_selection_request (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 XSelectionEvent reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 reply.type = SelectionNotify;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 reply.display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 reply.requestor = event->requestor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 reply.selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 reply.time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 reply.target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 reply.property = None;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 XFlush (reply.display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 /* Used as an unwind-protect clause so that, if a selection-converter signals
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 an error, we tell the requestor that we were unable to do what they wanted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 before we throw to top-level or go into the debugger or whatever.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 x_selection_request_lisp_error (Lisp_Object closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 get_opaque_ptr (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 free_opaque_ptr (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 if (event->type == 0) /* we set this to mean "completed normally" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 x_decline_selection_request (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 /* Convert our selection to the requested type, and put that data where the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 requestor wants it. Then tell them whether we've succeeded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 x_reply_selection_request (XSelectionRequestEvent *event, int format,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
467 UChar_Binary *data, Bytecount size, Atom type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 XSelectionEvent reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 Window window = event->requestor;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
474 Bytecount bytes_remaining;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 int format_bytes = format/8;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
476 Bytecount max_bytes = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 reply.type = SelectionNotify;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 reply.display = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 reply.requestor = window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 reply.selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 reply.time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 reply.target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 reply.property = (event->property == None ? event->target : event->property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 /* Store the data on the requested property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 If the selection is large, only store the first N bytes of it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 bytes_remaining = size * format_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 if (bytes_remaining <= max_bytes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 /* Send all the data at once, with minimal handshaking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 stderr_out ("\nStoring all %d\n", bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 PropModeReplace, data, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 /* At this point, the selection was successfully stored; ack it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 XFlush (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 /* Send an INCR selection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 int prop_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 if (x_window_to_frame (d, window)) /* #### debug */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
511 invalid_operation ("attempt to transfer an INCR to ourself!", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 stderr_out ("\nINCR %d\n", bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 prop_id = expect_property_change (display, window, reply.property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 PropertyDelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d),
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
519 32, PropModeReplace, (UChar_Binary *)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 &bytes_remaining, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 XSelectInput (display, window, PropertyChangeMask);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 /* Tell 'em the INCR data is there... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 XFlush (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 /* First, wait for the requestor to ack by deleting the property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 This can run random lisp code (process handlers) or signal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
533 Bytecount i = ((bytes_remaining < max_bytes)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 ? bytes_remaining
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 : max_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 prop_id = expect_property_change (display, window, reply.property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 PropertyDelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 stderr_out (" INCR adding %d\n", i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 /* Append the next chunk of data to the property. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 PropModeAppend, data, i / format_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 bytes_remaining -= i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 data += i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 /* Now wait for the requestor to ack this chunk by deleting the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 property. This can run random lisp code or signal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 /* Now write a zero-length chunk to the property to tell the requestor
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 that we're done. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 stderr_out (" INCR done\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 if (! waiting_for_other_props_on_window (display, window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 XSelectInput (display, window, 0L);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 PropModeReplace, data, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 /* Called from the event-loop in response to a SelectionRequest event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 x_handle_selection_request (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
573 struct gcpro gcpro1, gcpro2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
574 Lisp_Object temp_obj;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 Lisp_Object selection_symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 Lisp_Object target_symbol = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 Lisp_Object converted_selection = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 Time local_selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 Lisp_Object successful_p = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 struct device *d = get_device_from_display (event->display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
583 GCPRO2 (converted_selection, target_symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 selection_symbol = x_atom_to_symbol (d, event->selection);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
586 target_symbol = x_atom_to_symbol (d, event->target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
588 #if 0 /* #### MULTIPLE doesn't work yet */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
589 if (EQ (target_symbol, QMULTIPLE))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
590 target_symbol = fetch_multiple_target (event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
593 temp_obj = Fget_selection_timestamp (selection_symbol);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
594
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
595 if (NILP (temp_obj))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
597 /* We don't appear to have the selection. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 x_decline_selection_request (event);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
599
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
603 local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 if (event->time != CurrentTime &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 local_selection_time > event->time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 /* Someone asked for the selection, and we have one, but not the one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 they're looking for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 x_decline_selection_request (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614 converted_selection = select_convert_out (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
615 target_symbol, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
616
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
617 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 if (NILP (converted_selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620 /* We don't appear to have a selection in that data type. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
621 x_decline_selection_request (event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
622 goto DONE_LABEL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
623 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
624
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 record_unwind_protect (x_selection_request_lisp_error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 make_opaque_ptr (event));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
629 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
630 UChar_Binary *data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
631 Bytecount size;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
632 int format;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
633 Atom type;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
634 lisp_data_to_selection_data (d, converted_selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
635 &data, &type, &size, &format);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
637 x_reply_selection_request (event, format, data, size, type);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 successful_p = Qt;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639 /* Tell x_selection_request_lisp_error() it's cool. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
640 event->type = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
641 xfree (data);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
642 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
643
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
644 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 DONE_LABEL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 /* Let random lisp code notice that the selection has been asked for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 Lisp_Object val = Vx_sent_selection_hooks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 if (!UNBOUNDP (val) && !NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
655 Lisp_Object rest;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 for (rest = val; !NILP (rest); rest = Fcdr (rest))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
658 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
660 call3 (val, selection_symbol, target_symbol, successful_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 /* Called from the event-loop in response to a SelectionClear event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 x_handle_selection_clear (XSelectionClearEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 Atom selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 Time changed_owner_time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
676 Lisp_Object selection_symbol, local_selection_time_lisp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 Time local_selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 selection_symbol = x_atom_to_symbol (d, selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
681 local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
683 /* We don't own the selection, so that's fine. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
684 if (NILP (local_selection_time_lisp))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 return;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
687 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 /* This SelectionClear is for a selection that we no longer own, so we can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 disregard it. (That is, we have reasserted the selection since this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 request was generated.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 if (changed_owner_time != CurrentTime &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 local_selection_time > changed_owner_time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 return;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
696
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 handle_selection_clear (selection_symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 /* This stuff is so that INCR selections are reentrant (that is, so we can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 be servicing multiple INCR selection requests simultaneously). I haven't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 actually tested that yet.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 static int prop_location_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 static struct prop_location {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 int tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 Display *display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 Window window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 Atom property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 int desired_state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 struct prop_location *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 } *for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 property_deleted_p (void *tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 struct prop_location *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 if (rest->tick == (long) tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 waiting_for_other_props_on_window (Display *display, Window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 struct prop_location *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 if (rest->display == display && rest->window == window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 expect_property_change (Display *display, Window window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 Atom property, int state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 struct prop_location *pl = xnew (struct prop_location);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 pl->tick = ++prop_location_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 pl->display = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 pl->window = window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 pl->property = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 pl->desired_state = state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 pl->next = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 for_whom_the_bell_tolls = pl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 return pl->tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 unexpect_property_change (int tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 if (rest->tick == tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 prev->next = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 for_whom_the_bell_tolls = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 xfree (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 wait_for_property_change (long tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 wait_delaying_user_input (property_deleted_p, (void *) tick);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 /* Called from the event-loop in response to a PropertyNotify event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 x_handle_property_notify (XPropertyEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 if (rest->property == event->atom &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 rest->window == event->window &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 rest->display == event->display &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 rest->desired_state == event->state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 stderr_out ("Saw expected prop-%s on %s\n",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
801 (event->state == PropertyDelete ? "delete" : "change"),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
802 XSTRING_DATA
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
803 (XSYMBOL (x_atom_to_symbol
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
804 (get_device_from_display (event->display),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
805 event->atom))->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 prev->next = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 for_whom_the_bell_tolls = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 xfree (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 stderr_out ("Saw UNexpected prop-%s on %s\n",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
819 (event->state == PropertyDelete ? "delete" : "change"),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
820 XSTRING_DATA (XSYMBOL (x_atom_to_symbol
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
821 (get_device_from_display (event->display),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
822 event->atom))->name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 #if 0 /* #### MULTIPLE doesn't work yet */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 fetch_multiple_target (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 Window window = event->requestor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 Atom target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 Atom selection_atom = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 int result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 Fcons (QMULTIPLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 x_get_window_property_as_lisp_data (display, window, target,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 QMULTIPLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 selection_atom));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 copy_multiple_data (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 Lisp_Object vec;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
851 Elemcount i;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
852 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 if (CONSP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 CHECK_VECTOR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 len = XVECTOR_LENGTH (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 vec = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 for (i = 0; i < len; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 CHECK_VECTOR (vec2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 if (XVECTOR_LENGTH (vec2) != 2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
864 sferror ("vectors must be of length 2", vec2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 return vec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 static Window reading_selection_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 static Atom reading_which_selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 static int selection_reply_timed_out;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 selection_reply_done (void *ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 return !reading_selection_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 static Lisp_Object Qx_selection_reply_timeout_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 selection_reply_timed_out = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 reading_selection_reply = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 /* Do protocol to read selection-data from the server.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 Converts this to lisp data and returns it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 struct frame *sel_frame = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 int speccount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 XCAR (target_type) : target_type), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 XConvertSelection (display, selection_atom, type_atom, target_property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 requestor_window, requestor_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 /* Block until the reply has been read. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 reading_selection_reply = requestor_window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 reading_which_selection = selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 selection_reply_timed_out = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 /* add a timeout handler */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 if (x_selection_timeout > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 Qx_selection_reply_timeout_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 record_unwind_protect (Fdisable_timeout, id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 /* This is ^Gable */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 wait_delaying_user_input (selection_reply_done, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 if (selection_reply_timed_out)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
939 signal_error (Qselection_conversion_error, "timed out waiting for reply from selection owner", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
941 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 /* otherwise, the selection is waiting for us on the requested property. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 return select_convert_in (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946 target_type,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 x_get_window_property_as_lisp_data(display,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 requestor_window,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 target_property,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950 target_type,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
951 selection_atom));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 x_get_window_property (Display *display, Window window, Atom property,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
957 UChar_Binary **data_ret, Bytecount *bytes_ret,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 Atom *actual_type_ret, int *actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 unsigned long *actual_size_ret, int delete_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
961 Bytecount total_size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 unsigned long bytes_remaining;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
963 Bytecount offset = 0;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
964 UChar_Binary *tmp_data = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 int result;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
966 Bytecount buffer_size = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 /* First probe the thing to find out how big it is. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 result = XGetWindowProperty (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 0, 0, False, AnyPropertyType,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 actual_type_ret, actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 actual_size_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 &bytes_remaining, &tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 if (result != Success)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 *data_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 *bytes_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 XFree ((char *) tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 if (*actual_type_ret == None || *actual_format_ret == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 if (delete_p) XDeleteProperty (display, window, property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 *data_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 *bytes_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 total_size = bytes_remaining + 1;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
992 *data_ret = (UChar_Binary *) xmalloc (total_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 /* Now read, until we've gotten it all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 #if 0
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
998 Bytecount last = bytes_remaining;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 result =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 XGetWindowProperty (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 offset/4, buffer_size/4,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 (delete_p ? True : False),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 AnyPropertyType,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 actual_type_ret, actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 actual_size_ret, &bytes_remaining, &tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 stderr_out ("<< read %d\n", last-bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 /* If this doesn't return Success at this point, it means that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 some clod deleted the selection while we were in the midst of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 reading it. Deal with that, I guess....
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 if (result != Success) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 *actual_size_ret *= *actual_format_ret / 8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 offset += *actual_size_ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 XFree ((char *) tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 *bytes_ret = offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 receive_incremental_selection (Display *display, Window window, Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 /* this one is for error messages only */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 Lisp_Object target_type,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1028 Bytecount min_size_bytes,
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1029 UChar_Binary **data_ret,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1030 Bytecount *size_bytes_ret,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 Atom *type_ret, int *format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 unsigned long *size_ret)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1035 Bytecount offset = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 int prop_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 *size_bytes_ret = min_size_bytes;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1038 *data_ret = (UChar_Binary *) xmalloc (*size_bytes_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 stderr_out ("\nread INCR %d\n", min_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 /* At this point, we have read an INCR property, and deleted it (which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 is how we ack its receipt: the sending window will be selecting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 PropertyNotify events on our window to notice this).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 Now, we must loop, waiting for the sending window to put a value on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 that property, then reading the property, then deleting it to ack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 We are done when the sender places a property of length 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 prop_id = expect_property_change (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 PropertyNewValue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1054 UChar_Binary *tmp_data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1055 Bytecount tmp_size_bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 /* expect it again immediately, because x_get_window_property may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 .. no it won't, I don't get it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 .. Ok, I get it now, the Xt code that implements INCR is broken.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 prop_id = expect_property_change (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 PropertyNewValue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 x_get_window_property (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 &tmp_data, &tmp_size_bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 type_ret, format_ret, size_ret, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 if (tmp_size_bytes == 0) /* we're done */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 stderr_out (" read INCR done\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 unexpect_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 if (tmp_data) xfree (tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 stderr_out (" read INCR %d\n", tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 if (*size_bytes_ret < offset + tmp_size_bytes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 stderr_out (" read INCR realloc %d -> %d\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 *size_bytes_ret, offset + tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 *size_bytes_ret = offset + tmp_size_bytes;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1086 *data_ret = (UChar_Binary *) xrealloc (*data_ret, *size_bytes_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 offset += tmp_size_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 xfree (tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 x_get_window_property_as_lisp_data (Display *display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 Window window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 /* next two for error messages only */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 Lisp_Object target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 Atom selection_atom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 Atom actual_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 int actual_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 unsigned long actual_size;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1107 UChar_Binary *data = NULL;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1108 Bytecount bytes = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 x_get_window_property (display, window, property, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 &actual_type, &actual_format, &actual_size, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 if (! data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 if (XGetSelectionOwner (display, selection_atom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 /* there is a selection owner */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1118 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1119 "selection owner couldn't convert",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1120 Fcons (Qunbound,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1121 Fcons (x_atom_to_symbol (d, selection_atom),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1122 actual_type ?
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1123 list2 (target_type,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1124 x_atom_to_symbol (d, actual_type)) :
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1125 list1 (target_type))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1127 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1128 "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1129 x_atom_to_symbol (d, selection_atom));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 if (actual_type == DEVICE_XATOM_INCR (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 /* Ok, that data wasn't *the* data, it was just the beginning. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1136 Bytecount min_size_bytes =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1137 /* careful here. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1138 (Bytecount) (* ((unsigned int *) data));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 receive_incremental_selection (display, window, property, target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 min_size_bytes, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 &actual_type, &actual_format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 &actual_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 /* It's been read. Now convert it to a lisp object in some semi-rational
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 manner. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 val = selection_data_to_lisp_data (d, data, bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 actual_type, actual_format);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 /* Called from the event loop to handle SelectionNotify events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 I don't think this needs to be reentrant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 x_handle_selection_notify (XSelectionEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 if (! reading_selection_reply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 message ("received an unexpected SelectionNotify event");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 else if (event->requestor != reading_selection_reply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 message ("received a SelectionNotify event for the wrong window");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 else if (event->selection != reading_which_selection)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 message ("received the wrong selection type in SelectionNotify!");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 reading_selection_reply = 0; /* we're done now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 Time timestamp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 Atom selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 CHECK_SYMBOL (selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 if (NILP (timeval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 /* #### This is bogus. See the comment above about problems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 on OSF/1 and DEC Alphas. Yet another reason why it sucks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 to have the implementation (i.e. cons of two 16-bit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 integers) exposed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 lisp_to_time (timeval, &the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 timestamp = (Time) the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 selection_atom = symbol_to_x_atom (d, selection, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 XSetSelectionOwner (display, selection_atom, None, timestamp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1200 x_selection_exists_p (Lisp_Object selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1201 Lisp_Object selection_type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 Display *dpy = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 static int cut_buffers_initialized; /* Whether we're sure they all exist */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 initialize_cut_buffers (Display *display, Window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1218 static unsigned const char * const data = (unsigned const char *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 PropModeAppend, data, 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 FROB (XA_CUT_BUFFER0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 FROB (XA_CUT_BUFFER1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 FROB (XA_CUT_BUFFER2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 FROB (XA_CUT_BUFFER3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 FROB (XA_CUT_BUFFER4);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 FROB (XA_CUT_BUFFER5);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 FROB (XA_CUT_BUFFER6);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 FROB (XA_CUT_BUFFER7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 #undef FROB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 cut_buffers_initialized = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 #define CHECK_CUTBUFFER(symbol) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 CHECK_SYMBOL (symbol); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 if (! (EQ (symbol, QCUT_BUFFER0) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 EQ (symbol, QCUT_BUFFER1) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 EQ (symbol, QCUT_BUFFER2) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 EQ (symbol, QCUT_BUFFER3) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 EQ (symbol, QCUT_BUFFER4) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 EQ (symbol, QCUT_BUFFER5) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 EQ (symbol, QCUT_BUFFER6) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 EQ (symbol, QCUT_BUFFER7))) \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1243 invalid_constant ("Doesn't name a cutbuffer", symbol); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 (cutbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 Atom cut_buffer_atom;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1255 UChar_Binary *data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1256 Bytecount bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 Atom type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 int format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 unsigned long size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 Lisp_Object ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 CHECK_CUTBUFFER (cutbuffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 &type, &format, &size, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 if (!data) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 if (format != 8 || type != XA_STRING)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1270 invalid_state_2 ("Cut buffer doesn't contain 8-bit STRING data",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1271 x_atom_to_symbol (d, type),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1272 make_int (format));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 /* We cheat - if the string contains an ESC character, that's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 technically not allowed in a STRING, so we assume it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 COMPOUND_TEXT that we stored there ourselves earlier,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 in x-store-cutbuffer-internal */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 ret = (bytes ?
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1279 make_ext_string ((Extbyte *) data, bytes,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 memchr (data, 0x1b, bytes) ?
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1281 Qctext : Qbinary)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 return ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 (cutbuffer, string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 Atom cut_buffer_atom;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1297 const Intbyte *data = XSTRING_DATA (string);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1298 Bytecount bytes = XSTRING_LENGTH (string);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1299 Bytecount bytes_remaining;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1300 Bytecount max_bytes = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 #ifdef MULE
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1302 const Intbyte *ptr, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 if (max_bytes > MAX_SELECTION_QUANTUM)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 max_bytes = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 CHECK_CUTBUFFER (cutbuffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 if (! cut_buffers_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 initialize_cut_buffers (display, window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 The ICCCM requires that this be so, and other clients assume it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 as we do ourselves in initialize_cut_buffers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 /* Optimize for the common ASCII case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 for (ptr = data, end = ptr + bytes; ptr <= end; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1325 if (byte_ascii_p (*ptr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 (*ptr) == LEADING_BYTE_CONTROL_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 chartypes = LATIN_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 ptr += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 chartypes = WORLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 if (chartypes == LATIN_1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1344 TO_EXTERNAL_FORMAT (LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1345 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1346 Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 else if (chartypes == WORLD)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1348 TO_EXTERNAL_FORMAT (LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1349 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1350 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 bytes_remaining = bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1357 Bytecount chunk =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1358 bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 (bytes_remaining == bytes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 ? PropModeReplace : PropModeAppend),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 data, chunk);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 data += chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 bytes_remaining -= chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 return string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 Rotate the values of the cutbuffers by the given number of steps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 positive means move values forward, negative means backward.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 Atom props [8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 CHECK_INT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 if (XINT (n) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 return n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 if (! cut_buffers_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 initialize_cut_buffers (display, window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 props[0] = XA_CUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 props[1] = XA_CUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 props[2] = XA_CUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 props[3] = XA_CUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 props[4] = XA_CUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 props[5] = XA_CUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 props[6] = XA_CUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 props[7] = XA_CUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 XRotateWindowProperties (display, window, props, 8, XINT (n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 return n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1407 syms_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 DEFSUBR (Fx_get_cutbuffer_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 DEFSUBR (Fx_store_cutbuffer_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 DEFSUBR (Fx_rotate_cutbuffers_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 /* Unfortunately, timeout handlers must be lisp functions. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1417 DEFSYMBOL (Qx_selection_reply_timeout_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 DEFSUBR (Fx_selection_reply_timeout_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 console_type_create_select_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 CONSOLE_HAS_METHOD (x, own_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 CONSOLE_HAS_METHOD (x, disown_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 CONSOLE_HAS_METHOD (x, get_foreign_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 CONSOLE_HAS_METHOD (x, selection_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1442 reinit_vars_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 reading_selection_reply = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 reading_which_selection = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 selection_reply_timed_out = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 for_whom_the_bell_tolls = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 prop_location_tick = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1452 vars_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1454 reinit_vars_of_select_x ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 cut_buffers_initialized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 Fprovide (intern ("cut-buffer"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 A function or functions to be called after we have responded to some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 other client's request for the value of a selection that we own. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 function(s) will be called with four arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 - the name of the selection-type which we were requested to convert the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 selection into before sending (for example, STRING or LENGTH);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 - and whether we successfully transmitted the selection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 We might have failed (and declined the request) for any number of reasons,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 including being asked for a selection that we no longer own, or being asked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 to convert into a type that we don't know about or that is inappropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 This hook doesn't let you change the behavior of emacs's selection replies,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 it merely informs you that they have happened.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 Vx_sent_selection_hooks = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 If the selection owner doesn't reply in this many seconds, we give up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 A value of 0 means wait as long as necessary. This is initialized from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 \"*selectionTimeout\" resource (which is expressed in milliseconds).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 x_selection_timeout = 0;
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1483
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1484 DEFVAR_BOOL ("x-selection-strict-motif-ownership", &x_selection_strict_motif_ownership /*
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1485 *If true and XEmacs already owns the clipboard, don't own it again in the
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1486 Motif way. Owning the selection on the Motif way does a huge amount of
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1487 X protocol, and it makes killing text incredibly slow when using an
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1488 X terminal. However, when enabled Motif text fields don't bother to look up
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1489 the new value, and you can't Copy from a buffer, Paste into a text
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1490 field, then Copy something else from the buffer and paste it into the
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1491 text field; it pastes the first thing again.
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1492 */ );
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1493 x_selection_strict_motif_ownership = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1497 Xatoms_of_select_x (struct device *d)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 Display *D = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 /* Non-predefined atoms that we might end up using a lot */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1512
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1513 /* #### I don't like the looks of this... what is it for? - ajh */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 }