annotate src/select-x.c @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents b39c14581166
children 943eaba38521
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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 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
8 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 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
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 /* Synched up with: Not synched with FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Rewritten by jwz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "console-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "objects-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "select.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 int lisp_to_time (Lisp_Object, time_t *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 Lisp_Object time_to_lisp (time_t);
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 #ifdef LWLIB_USES_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 # define MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #ifdef MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 # include <Xm/CutPaste.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 static void hack_motif_clipboard_selection (Atom selection_atom,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 Lisp_Object selection_value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 Time thyme, Display *display,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
49 Window selecting_window,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
50 int owned_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #define CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 Lisp_Object Vx_sent_selection_hooks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 /* 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
63 emacs will use INCR selection transfer when the selection is larger
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 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
65 emacs to use incremental selection transfers when the selection is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 smaller than that, set this. I added this mostly for debugging the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 incremental transfer stuff, but it might improve server performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 #define MAX_SELECTION_QUANTUM 0xFFFFFF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 /* 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
74 we give up on it. This is in seconds (0 = no timeout).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
76 Fixnum x_selection_timeout;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
78 /* Enable motif selection optimizations. */
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
79 int x_selection_strict_motif_ownership;
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
80
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 /* Utility functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 static Lisp_Object x_get_window_property_as_lisp_data (Display *,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 Window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Lisp_Object target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Atom selection_atom);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 static int expect_property_change (Display *, Window, Atom prop, int state);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 static void wait_for_property_change (long);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 static void unexpect_property_change (int);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 static int waiting_for_other_props_on_window (Display *, Window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 /* This converts a Lisp symbol to a server Atom, avoiding a server
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 roundtrip whenever possible.
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 static Atom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 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
100 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 if (NILP (sym)) return XA_PRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 if (EQ (sym, Qt)) return XA_SECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 if (EQ (sym, QSTRING)) return XA_STRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 if (EQ (sym, QINTEGER)) return XA_INTEGER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 if (EQ (sym, QATOM)) return XA_ATOM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
134 const Extbyte *nameext;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
135 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 return XInternAtom (display, nameext, only_if_exists ? True : False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
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 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 and calls to intern whenever possible.
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 x_atom_to_symbol (struct device *d, Atom atom)
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 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 if (! atom) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 if (atom == XA_PRIMARY) return QPRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 if (atom == XA_SECONDARY) return QSECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 if (atom == XA_STRING) return QSTRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 if (atom == XA_INTEGER) return QINTEGER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 if (atom == XA_ATOM) return QATOM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 if (atom == DEVICE_XATOM_INCR (d)) return QINCR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 if (atom == DEVICE_XATOM_NULL (d)) return QNULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
179 char *intstr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 char *str = XGetAtomName (display, atom);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 if (! str) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
184 TO_INTERNAL_FORMAT (C_STRING, str,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
185 C_STRING_ALLOCA, intstr,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
186 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 XFree (str);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
188 return intern (intstr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
192 #define PROCESSING_X_CODE
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
193 #include "select-common.h"
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
194 #undef PROCESSING_X_CODE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 /* Do protocol to assert ourself as a selection owner.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
199 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
200 Lisp_Object how_to_add, Lisp_Object selection_type,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
201 int owned_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 struct frame *sel_frame = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Lisp_Object selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 /* Use the time of the last-read mouse or keyboard event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 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
210 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
211 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
212 selection, which is probably true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Atom selection_atom;
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 CHECK_SYMBOL (selection_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 selection_atom = symbol_to_x_atom (d, selection_name, 0);
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 XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 /* 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
223 That assumed equivalence of time_t and Time, which is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 necessarily the case (e.g. under OSF on the Alphas, where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 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
226
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Opaque pointers are the clean way to go here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
229 selection_time = make_opaque (&thyme, sizeof (thyme));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 #ifdef MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 hack_motif_clipboard_selection (selection_atom, selection_value,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
233 thyme, display, selecting_window, owned_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 return selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
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 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 static void motif_clipboard_cb ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 hack_motif_clipboard_selection (Atom selection_atom,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 Lisp_Object selection_value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 Time thyme,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 Display *display,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
249 Window selecting_window,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
250 int owned_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 /* 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
254 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
255 this so that linked-in Motif widgets don't get themselves wedged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 && STRINGP (selection_value)
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 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
261 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
262 be current, but owning the selection on the Motif way does a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 SHITLOAD of X protocol, and it makes killing text be incredibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 slow when using an X terminal. ARRRRGGGHHH!!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 /* 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
267 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
268 into a text field, then Copy something else from the buffer and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 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
270 && (!owned_p
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
271 /* Selectively re-enable this because for most users its
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
272 just too painful - especially over a remote link. */
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
273 || x_selection_strict_motif_ownership)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 long itemid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 #if XmVersion >= 1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 long dataid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 XmString fmh;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 String encoding = "STRING";
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
287 const Intbyte *data = XSTRING_DATA (selection_value);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
288 Bytecount bytes = XSTRING_LENGTH (selection_value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
293 const Intbyte *ptr = data, *end = ptr + bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 /* Optimize for the common ASCII case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 while (ptr <= end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 if (BYTE_ASCII_P (*ptr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 continue;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (*ptr) == LEADING_BYTE_CONTROL_1)
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 chartypes = LATIN_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 ptr += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 chartypes = WORLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 if (chartypes == LATIN_1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
316 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
317 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
318 Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 else if (chartypes == WORLD)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
321 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
322 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
323 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 encoding = "COMPOUND_TEXT";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 #endif /* MULE */
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 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 XmClipboardStartCopy (display, selecting_window, fmh, thyme,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 widget, motif_clipboard_cb,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 0, NULL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 &itemid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 XmStringFree (fmh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 XmClipboardCopy (display, selecting_window, itemid, encoding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 /* O'Reilly examples say size can be 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 but this clearly is not the case. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 0, bytes, (int) selecting_window, /* private id */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (XtPointer) data, bytes, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 &dataid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 XmClipboardEndCopy (display, selecting_window, itemid))
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 }
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 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 /* 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
359 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
360 work at all unless the selection owner and requestor are in different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 processes. From reading the Motif source, it looks like they never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 even considered having two widgets in the same application transfer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 data between each other using "by-name" clipboard values. What a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 bunch of fuckups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 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
368 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 switch (*reason)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 case XmCR_CLIPBOARD_DATA_REQUEST:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 Display *dpy = XtDisplay (widget);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 Window window = (Window) *private_id;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
375 Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
376
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
377 /* Whichever lazy git wrote this originally just called abort()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
378 when anything didn't go their way... */
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 /* Try some other text types */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
381 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
382 selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
383 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
384 selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
385 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
386 selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
387
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
388 if (CONSP (selection) && SYMBOLP (XCAR (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
389 && (EQ (XCAR (selection), QSTRING)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
390 || EQ (XCAR (selection), QTEXT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
391 || EQ (XCAR (selection), QCOMPOUND_TEXT)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
392 selection = XCDR (selection);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
393
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
394 if (NILP (selection))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
395 signal_error (Qselection_conversion_error, "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
396 Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
397
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
398 if (!STRINGP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
399 signal_error (Qselection_conversion_error,
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
400 "couldn't convert selection to string", Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
401
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
402
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 XmClipboardCopyByName (dpy, window, *data_id,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (char *) XSTRING_DATA (selection),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 XSTRING_LENGTH (selection) + 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 case XmCR_CLIPBOARD_DATA_DELETE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 /* don't need to free anything */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 #endif /* MOTIF_CLIPBOARDS */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
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 /* Send a SelectionNotify event to the requestor with property=None, meaning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 we were unable to do what they wanted.
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 x_decline_selection_request (XSelectionRequestEvent *event)
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 XSelectionEvent reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 reply.type = SelectionNotify;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 reply.display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 reply.requestor = event->requestor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 reply.selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 reply.time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 reply.target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 reply.property = None;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 XFlush (reply.display);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 /* 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
442 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
443 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
444 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 x_selection_request_lisp_error (Lisp_Object closure)
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 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 get_opaque_ptr (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 free_opaque_ptr (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 if (event->type == 0) /* we set this to mean "completed normally" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 x_decline_selection_request (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 /* 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
460 requestor wants it. Then tell them whether we've succeeded.
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 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
464 UChar_Binary *data, Bytecount size, Atom type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 XSelectionEvent reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 Window window = event->requestor;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
471 Bytecount bytes_remaining;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 int format_bytes = format/8;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
473 Bytecount max_bytes = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 reply.type = SelectionNotify;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 reply.display = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 reply.requestor = window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 reply.selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 reply.time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 reply.target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 reply.property = (event->property == None ? event->target : event->property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 /* Store the data on the requested property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 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
488 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 bytes_remaining = size * format_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 if (bytes_remaining <= max_bytes)
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 /* Send all the data at once, with minimal handshaking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 stderr_out ("\nStoring all %d\n", bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 PropModeReplace, data, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 /* At this point, the selection was successfully stored; ack it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 XFlush (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 /* Send an INCR selection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 int prop_id;
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 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
508 invalid_operation ("attempt to transfer an INCR to ourself!", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 stderr_out ("\nINCR %d\n", bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 prop_id = expect_property_change (display, window, reply.property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 PropertyDelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 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
516 32, PropModeReplace, (UChar_Binary *)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 &bytes_remaining, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 XSelectInput (display, window, PropertyChangeMask);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 /* Tell 'em the INCR data is there... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 XFlush (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 /* First, wait for the requestor to ack by deleting the property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 This can run random lisp code (process handlers) or signal.
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 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
530 Bytecount i = ((bytes_remaining < max_bytes)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 ? bytes_remaining
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 : max_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 prop_id = expect_property_change (display, window, reply.property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 PropertyDelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 stderr_out (" INCR adding %d\n", i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 /* Append the next chunk of data to the property. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 PropModeAppend, data, i / format_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 bytes_remaining -= i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 data += i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 /* Now wait for the requestor to ack this chunk by deleting the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 property. This can run random lisp code or signal.
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 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 /* 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
550 that we're done. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 stderr_out (" INCR done\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 if (! waiting_for_other_props_on_window (display, window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 XSelectInput (display, window, 0L);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 PropModeReplace, data, 0);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
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 /* Called from the event-loop in response to a SelectionRequest event.
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 x_handle_selection_request (XSelectionRequestEvent *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 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
570 struct gcpro gcpro1, gcpro2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
571 Lisp_Object temp_obj;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 Lisp_Object selection_symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 Lisp_Object target_symbol = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 Lisp_Object converted_selection = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 Time local_selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 Lisp_Object successful_p = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 struct device *d = get_device_from_display (event->display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
580 GCPRO2 (converted_selection, target_symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 selection_symbol = x_atom_to_symbol (d, event->selection);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
583 target_symbol = x_atom_to_symbol (d, event->target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
585 #if 0 /* #### MULTIPLE doesn't work yet */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
586 if (EQ (target_symbol, QMULTIPLE))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
587 target_symbol = fetch_multiple_target (event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
590 temp_obj = Fget_selection_timestamp (selection_symbol);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
591
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
592 if (NILP (temp_obj))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
594 /* We don't appear to have the selection. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 x_decline_selection_request (event);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
596
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
600 local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj);
428
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 if (event->time != CurrentTime &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 local_selection_time > event->time)
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 /* 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
606 they're looking for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 x_decline_selection_request (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
611 converted_selection = select_convert_out (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
612 target_symbol, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
613
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614 /* #### 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
615 if (NILP (converted_selection))
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 /* 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
618 x_decline_selection_request (event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 goto DONE_LABEL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
621
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 record_unwind_protect (x_selection_request_lisp_error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 make_opaque_ptr (event));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
626 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
627 UChar_Binary *data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
628 Bytecount size;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
629 int format;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
630 Atom type;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
631 lisp_data_to_selection_data (d, converted_selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
632 &data, &type, &size, &format);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
634 x_reply_selection_request (event, format, data, size, type);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
635 successful_p = Qt;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
636 /* Tell x_selection_request_lisp_error() it's cool. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
637 event->type = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 xfree (data);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
640
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 unbind_to (count, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 DONE_LABEL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 /* Let random lisp code notice that the selection has been asked for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 Lisp_Object val = Vx_sent_selection_hooks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 if (!UNBOUNDP (val) && !NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
652 Lisp_Object rest;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 for (rest = val; !NILP (rest); rest = Fcdr (rest))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
655 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
657 call3 (val, selection_symbol, target_symbol, successful_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 }
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 /* Called from the event-loop in response to a SelectionClear event.
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 x_handle_selection_clear (XSelectionClearEvent *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 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 Atom selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 Time changed_owner_time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
673 Lisp_Object selection_symbol, local_selection_time_lisp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 Time local_selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 selection_symbol = x_atom_to_symbol (d, selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
678 local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
680 /* We don't own the selection, so that's fine. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
681 if (NILP (local_selection_time_lisp))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
682 return;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
684 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 /* 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
687 disregard it. (That is, we have reasserted the selection since this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 request was generated.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 if (changed_owner_time != CurrentTime &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 local_selection_time > changed_owner_time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 return;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
693
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 handle_selection_clear (selection_symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 /* 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
699 be servicing multiple INCR selection requests simultaneously). I haven't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 actually tested that yet.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 static int prop_location_tick;
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 static struct prop_location {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 int tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 Display *display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 Window window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 Atom property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 int desired_state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 struct prop_location *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 } *for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 property_deleted_p (void *tick)
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 struct prop_location *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 if (rest->tick == (long) tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 waiting_for_other_props_on_window (Display *display, Window window)
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 struct prop_location *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 if (rest->display == display && rest->window == window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 expect_property_change (Display *display, Window window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 Atom property, int state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 struct prop_location *pl = xnew (struct prop_location);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 pl->tick = ++prop_location_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 pl->display = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 pl->window = window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 pl->property = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 pl->desired_state = state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 pl->next = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 for_whom_the_bell_tolls = pl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 return pl->tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 unexpect_property_change (int tick)
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 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 while (rest)
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 if (rest->tick == tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 prev->next = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 for_whom_the_bell_tolls = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 xfree (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 rest = rest->next;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 wait_for_property_change (long tick)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 wait_delaying_user_input (property_deleted_p, (void *) 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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 /* Called from the event-loop in response to a PropertyNotify event.
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 x_handle_property_notify (XPropertyEvent *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 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 while (rest)
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 if (rest->property == event->atom &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 rest->window == event->window &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 rest->display == event->display &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 rest->desired_state == event->state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 stderr_out ("Saw expected prop-%s on %s\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (event->state == PropertyDelete ? "delete" : "change"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 prev->next = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 for_whom_the_bell_tolls = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 xfree (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 stderr_out ("Saw UNexpected prop-%s on %s\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 (event->state == PropertyDelete ? "delete" : "change"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 #endif
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 #if 0 /* #### MULTIPLE doesn't work yet */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 fetch_multiple_target (XSelectionRequestEvent *event)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 Window window = event->requestor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 Atom target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 Atom selection_atom = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 int result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 Fcons (QMULTIPLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 x_get_window_property_as_lisp_data (display, window, target,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 QMULTIPLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 selection_atom));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 copy_multiple_data (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 Lisp_Object vec;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
843 Elemcount i;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
844 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 if (CONSP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 CHECK_VECTOR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 len = XVECTOR_LENGTH (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 vec = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 for (i = 0; i < len; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 CHECK_VECTOR (vec2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 if (XVECTOR_LENGTH (vec2) != 2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
856 sferror ("vectors must be of length 2", vec2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
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 return vec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 static Window reading_selection_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 static Atom reading_which_selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 static int selection_reply_timed_out;
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 selection_reply_done (void *ignore)
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 return !reading_selection_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 static Lisp_Object Qx_selection_reply_timeout_internal;
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 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 1, 1, 0, /*
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 (arg))
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 selection_reply_timed_out = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 reading_selection_reply = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888
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 /* Do protocol to read selection-data from the server.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 Converts this to lisp data and returns it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 struct frame *sel_frame = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 int speccount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 XCAR (target_type) : target_type), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 XConvertSelection (display, selection_atom, type_atom, target_property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 requestor_window, requestor_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 /* Block until the reply has been read. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 reading_selection_reply = requestor_window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 reading_which_selection = selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 selection_reply_timed_out = 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 speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 /* add a timeout handler */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 if (x_selection_timeout > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 Qx_selection_reply_timeout_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 record_unwind_protect (Fdisable_timeout, id);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 /* This is ^Gable */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 wait_delaying_user_input (selection_reply_done, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 if (selection_reply_timed_out)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
931 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
932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 unbind_to (speccount, Qnil);
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 /* 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
936
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
937 return select_convert_in (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
938 target_type,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 x_get_window_property_as_lisp_data(display,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
940 requestor_window,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941 target_property,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942 target_type,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 selection_atom));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 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
949 UChar_Binary **data_ret, Bytecount *bytes_ret,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 Atom *actual_type_ret, int *actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 unsigned long *actual_size_ret, int delete_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
953 Bytecount total_size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 unsigned long bytes_remaining;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
955 Bytecount offset = 0;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
956 UChar_Binary *tmp_data = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 int result;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
958 Bytecount buffer_size = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 /* First probe the thing to find out how big it is. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 result = XGetWindowProperty (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 0, 0, False, AnyPropertyType,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 actual_type_ret, actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 actual_size_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 &bytes_remaining, &tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 if (result != Success)
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 *data_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 *bytes_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 XFree ((char *) tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 if (*actual_type_ret == None || *actual_format_ret == 0)
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 if (delete_p) XDeleteProperty (display, window, property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 *data_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 *bytes_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 }
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 total_size = bytes_remaining + 1;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
984 *data_ret = (UChar_Binary *) xmalloc (total_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 /* Now read, until we've gotten it all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 #if 0
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
990 Bytecount last = bytes_remaining;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 result =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 XGetWindowProperty (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 offset/4, buffer_size/4,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 (delete_p ? True : False),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 AnyPropertyType,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 actual_type_ret, actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 actual_size_ret, &bytes_remaining, &tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 stderr_out ("<< read %d\n", last-bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 /* If this doesn't return Success at this point, it means that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 some clod deleted the selection while we were in the midst of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 reading it. Deal with that, I guess....
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 if (result != Success) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 *actual_size_ret *= *actual_format_ret / 8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 offset += *actual_size_ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 XFree ((char *) tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 *bytes_ret = offset;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 receive_incremental_selection (Display *display, Window window, Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 /* this one is for error messages only */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 Lisp_Object target_type,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1020 Bytecount min_size_bytes,
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1021 UChar_Binary **data_ret,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1022 Bytecount *size_bytes_ret,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 Atom *type_ret, int *format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 unsigned long *size_ret)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1027 Bytecount offset = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 int prop_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 *size_bytes_ret = min_size_bytes;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1030 *data_ret = (UChar_Binary *) xmalloc (*size_bytes_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 stderr_out ("\nread INCR %d\n", min_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 /* 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
1035 is how we ack its receipt: the sending window will be selecting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 PropertyNotify events on our window to notice this).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 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
1039 that property, then reading the property, then deleting it to ack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 We are done when the sender places a property of length 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 prop_id = expect_property_change (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 PropertyNewValue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1046 UChar_Binary *tmp_data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1047 Bytecount tmp_size_bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 /* expect it again immediately, because x_get_window_property may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 .. no it won't, I don't get it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 .. 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
1052 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 prop_id = expect_property_change (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 PropertyNewValue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 x_get_window_property (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 &tmp_data, &tmp_size_bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 type_ret, format_ret, size_ret, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 if (tmp_size_bytes == 0) /* we're done */
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 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 stderr_out (" read INCR done\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 unexpect_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 if (tmp_data) xfree (tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 stderr_out (" read INCR %d\n", tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 if (*size_bytes_ret < offset + tmp_size_bytes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 stderr_out (" read INCR realloc %d -> %d\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 *size_bytes_ret, offset + tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 *size_bytes_ret = offset + tmp_size_bytes;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1078 *data_ret = (UChar_Binary *) xrealloc (*data_ret, *size_bytes_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 offset += tmp_size_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 xfree (tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 x_get_window_property_as_lisp_data (Display *display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 Window window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 /* next two for error messages only */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 Lisp_Object target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 Atom selection_atom)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 Atom actual_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 int actual_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 unsigned long actual_size;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1099 UChar_Binary *data = NULL;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1100 Bytecount bytes = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 x_get_window_property (display, window, property, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 &actual_type, &actual_format, &actual_size, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 if (! data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 if (XGetSelectionOwner (display, selection_atom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 /* there is a selection owner */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1110 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1111 "selection owner couldn't convert",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1112 Fcons (Qunbound,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1113 Fcons (x_atom_to_symbol (d, selection_atom),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1114 actual_type ?
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1115 list2 (target_type,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1116 x_atom_to_symbol (d, actual_type)) :
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1117 list1 (target_type))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1119 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1120 "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1121 x_atom_to_symbol (d, selection_atom));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 if (actual_type == DEVICE_XATOM_INCR (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 /* Ok, that data wasn't *the* data, it was just the beginning. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1128 Bytecount min_size_bytes =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1129 /* careful here. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1130 (Bytecount) (* ((unsigned int *) data));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 receive_incremental_selection (display, window, property, target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 min_size_bytes, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 &actual_type, &actual_format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 &actual_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 /* 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
1139 manner. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 val = selection_data_to_lisp_data (d, data, bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 actual_type, actual_format);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 return val;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 /* Called from the event loop to handle SelectionNotify events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 I don't think this needs to be reentrant.
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 x_handle_selection_notify (XSelectionEvent *event)
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 if (! reading_selection_reply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 message ("received an unexpected SelectionNotify event");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 else if (event->requestor != reading_selection_reply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 message ("received a SelectionNotify event for the wrong window");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 else if (event->selection != reading_which_selection)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 message ("received the wrong selection type in SelectionNotify!");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 reading_selection_reply = 0; /* we're done now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 Time timestamp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 Atom selection_atom;
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 CHECK_SYMBOL (selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 if (NILP (timeval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 /* #### This is bogus. See the comment above about problems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 on OSF/1 and DEC Alphas. Yet another reason why it sucks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 to have the implementation (i.e. cons of two 16-bit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 integers) exposed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 lisp_to_time (timeval, &the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 timestamp = (Time) the_time;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 selection_atom = symbol_to_x_atom (d, selection, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 XSetSelectionOwner (display, selection_atom, None, timestamp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1192 x_selection_exists_p (Lisp_Object selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1193 Lisp_Object selection_type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 Display *dpy = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 static int cut_buffers_initialized; /* Whether we're sure they all exist */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 initialize_cut_buffers (Display *display, Window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1210 static unsigned const char * const data = (unsigned const char *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 PropModeAppend, data, 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 FROB (XA_CUT_BUFFER0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 FROB (XA_CUT_BUFFER1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 FROB (XA_CUT_BUFFER2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 FROB (XA_CUT_BUFFER3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 FROB (XA_CUT_BUFFER4);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 FROB (XA_CUT_BUFFER5);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 FROB (XA_CUT_BUFFER6);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 FROB (XA_CUT_BUFFER7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 #undef FROB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 cut_buffers_initialized = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 #define CHECK_CUTBUFFER(symbol) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 CHECK_SYMBOL (symbol); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 if (! (EQ (symbol, QCUT_BUFFER0) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 EQ (symbol, QCUT_BUFFER1) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 EQ (symbol, QCUT_BUFFER2) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 EQ (symbol, QCUT_BUFFER3) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 EQ (symbol, QCUT_BUFFER4) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 EQ (symbol, QCUT_BUFFER5) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 EQ (symbol, QCUT_BUFFER6) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 EQ (symbol, QCUT_BUFFER7))) \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1235 invalid_constant ("Doesn't name a cutbuffer", symbol); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 (cutbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 Atom cut_buffer_atom;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1247 UChar_Binary *data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1248 Bytecount bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 Atom type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 int format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 unsigned long size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 Lisp_Object ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 CHECK_CUTBUFFER (cutbuffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 &type, &format, &size, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 if (!data) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 if (format != 8 || type != XA_STRING)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1262 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
1263 x_atom_to_symbol (d, type),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1264 make_int (format));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 /* We cheat - if the string contains an ESC character, that's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 technically not allowed in a STRING, so we assume it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 COMPOUND_TEXT that we stored there ourselves earlier,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 in x-store-cutbuffer-internal */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 ret = (bytes ?
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1271 make_ext_string ((Extbyte *) data, bytes,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 memchr (data, 0x1b, bytes) ?
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1273 Qctext : Qbinary)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 return ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 (cutbuffer, string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 Atom cut_buffer_atom;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1289 const Intbyte *data = XSTRING_DATA (string);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1290 Bytecount bytes = XSTRING_LENGTH (string);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1291 Bytecount bytes_remaining;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1292 Bytecount max_bytes = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 #ifdef MULE
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1294 const Intbyte *ptr, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 if (max_bytes > MAX_SELECTION_QUANTUM)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 max_bytes = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 CHECK_CUTBUFFER (cutbuffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 if (! cut_buffers_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 initialize_cut_buffers (display, window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 /* 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
1309 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 The ICCCM requires that this be so, and other clients assume it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 as we do ourselves in initialize_cut_buffers. */
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 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 /* Optimize for the common ASCII case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 for (ptr = data, end = ptr + bytes; ptr <= end; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 if (BYTE_ASCII_P (*ptr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 (*ptr) == LEADING_BYTE_CONTROL_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 chartypes = LATIN_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 ptr += 2;
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 chartypes = WORLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 if (chartypes == LATIN_1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1336 TO_EXTERNAL_FORMAT (LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1337 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1338 Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 else if (chartypes == WORLD)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1340 TO_EXTERNAL_FORMAT (LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1341 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1342 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 bytes_remaining = bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1349 Bytecount chunk =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1350 bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 (bytes_remaining == bytes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 ? PropModeReplace : PropModeAppend),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 data, chunk);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 data += chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 bytes_remaining -= chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 return string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 Rotate the values of the cutbuffers by the given number of steps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 positive means move values forward, negative means backward.
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 (n))
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 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 Atom props [8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 CHECK_INT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 if (XINT (n) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 return n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 if (! cut_buffers_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 initialize_cut_buffers (display, window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 props[0] = XA_CUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 props[1] = XA_CUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 props[2] = XA_CUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 props[3] = XA_CUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 props[4] = XA_CUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 props[5] = XA_CUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 props[6] = XA_CUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 props[7] = XA_CUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 XRotateWindowProperties (display, window, props, 8, XINT (n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 return n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 /* initialization */
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 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1399 syms_of_select_x (void)
428
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 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 DEFSUBR (Fx_get_cutbuffer_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 DEFSUBR (Fx_store_cutbuffer_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 DEFSUBR (Fx_rotate_cutbuffers_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 /* Unfortunately, timeout handlers must be lisp functions. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1409 DEFSYMBOL (Qx_selection_reply_timeout_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 DEFSUBR (Fx_selection_reply_timeout_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 console_type_create_select_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 CONSOLE_HAS_METHOD (x, own_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 CONSOLE_HAS_METHOD (x, disown_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 CONSOLE_HAS_METHOD (x, get_foreign_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 CONSOLE_HAS_METHOD (x, selection_exists_p);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1434 reinit_vars_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 reading_selection_reply = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 reading_which_selection = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 selection_reply_timed_out = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 for_whom_the_bell_tolls = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 prop_location_tick = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1444 vars_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1446 reinit_vars_of_select_x ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 cut_buffers_initialized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 Fprovide (intern ("cut-buffer"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 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
1455 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
1456 function(s) will be called with four arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 - 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
1459 selection into before sending (for example, STRING or LENGTH);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 - and whether we successfully transmitted the selection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 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
1462 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
1463 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
1464 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
1465 it merely informs you that they have happened.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 Vx_sent_selection_hooks = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 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
1471 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
1472 \"*selectionTimeout\" resource (which is expressed in milliseconds).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 x_selection_timeout = 0;
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1475
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1476 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
1477 *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
1478 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
1479 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
1480 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
1481 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
1482 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
1483 text field; it pastes the first thing again.
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1484 */ );
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1485 x_selection_strict_motif_ownership = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1489 Xatoms_of_select_x (struct device *d)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 Display *D = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 /* Non-predefined atoms that we might end up using a lot */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1504
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1505 /* #### 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
1506 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 }