annotate src/select.c @ 440:8de8e3f6228a r21-2-28

Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents da8ed4261e83
children abe6d1db359e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
414
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
1 /* Generic selection processing for XEmacs
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
2 Copyright (C) 1999 Free Software Foundation, Inc.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
3 Copyright (C) 1999 Andy Piper.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
4
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
5 This file is part of XEmacs.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
6
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
10 later version.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
11
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
15 for more details.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
16
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
21
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
22 /* Synched up with: Not synched with FSF. */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
23
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
24 #include <config.h>
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
25 #include "lisp.h"
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
26
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
27 #include "buffer.h"
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
28 #include "device.h"
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
29 #include "console.h"
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
30 #include "objects.h"
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
31
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
32 #include "frame.h"
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
33 #include "opaque.h"
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
34 #include "select.h"
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
35
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
36 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
37 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
38 QATOM_PAIR, QCOMPOUND_TEXT;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
39
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
40 /* "Selection owner couldn't convert selection" */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
41 Lisp_Object Qselection_conversion_error;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
42
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
43 /* This is an alist whose CARs are selection-types (whose names are the same
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
44 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
45 call to convert the given Emacs selection value to a string representing
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
46 the given selection type. This is for elisp-level extension of the emacs
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
47 selection handling.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
48 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
49 Lisp_Object Vselection_converter_alist;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
50
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
51 Lisp_Object Vlost_selection_hooks;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
52
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
53 /* This is an association list whose elements are of the form
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
54 ( selection-name selection-value selection-timestamp )
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
55 selection-name is a lisp symbol, whose name is the name of an X Atom.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
56 selection-value is the value that emacs owns for that selection.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
57 It may be any kind of Lisp object.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
58 selection-timestamp is the time at which emacs began owning this selection,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
59 as a cons of two 16-bit numbers (making a 32 bit time).
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
60 If there is an entry in this alist, then it can be assumed that emacs owns
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
61 that selection.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
62 The only (eq) parts of this list that are visible from elisp are the
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
63 selection-values.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
64 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
65 Lisp_Object Vselection_alist;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
66
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
67 static Lisp_Object
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
68 clean_local_selection_data (Lisp_Object obj)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
69 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
70 if (CONSP (obj) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
71 INTP (XCAR (obj)) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
72 CONSP (XCDR (obj)) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
73 INTP (XCAR (XCDR (obj))) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
74 NILP (XCDR (XCDR (obj))))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
75 obj = Fcons (XCAR (obj), XCDR (obj));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
76
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
77 if (CONSP (obj) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
78 INTP (XCAR (obj)) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
79 INTP (XCDR (obj)))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
80 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
81 if (XINT (XCAR (obj)) == 0)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
82 return XCDR (obj);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
83 if (XINT (XCAR (obj)) == -1)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
84 return make_int (- XINT (XCDR (obj)));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
85 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
86 if (VECTORP (obj))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
87 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
88 int i;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
89 int len = XVECTOR_LENGTH (obj);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
90 Lisp_Object copy;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
91 if (len == 1)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
92 return clean_local_selection_data (XVECTOR_DATA (obj) [0]);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
93 copy = make_vector (len, Qnil);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
94 for (i = 0; i < len; i++)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
95 XVECTOR_DATA (copy) [i] =
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
96 clean_local_selection_data (XVECTOR_DATA (obj) [i]);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
97 return copy;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
98 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
99 return obj;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
100 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
101
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
102 /* Given a selection-name and desired type, this looks up our local copy of
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
103 the selection value and converts it to the type. It returns nil or a
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
104 string. This calls random elisp code, and may signal or gc.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
105 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
106 Lisp_Object
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
107 get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
108 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
109 /* This function can GC */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
110 Lisp_Object handler_fn, value, check;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
111 Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
112
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
113 if (NILP (local_value)) return Qnil;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
114
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
115 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
116 if (EQ (target_type, QTIMESTAMP))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
117 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
118 handler_fn = Qnil;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
119 value = XCAR (XCDR (XCDR (local_value)));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
120 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
121
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
122 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
123 else if (CONSP (target_type) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
124 XCAR (target_type) == QMULTIPLE)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
125 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
126 Lisp_Object pairs = XCDR (target_type);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
127 int len = XVECTOR_LENGTH (pairs);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
128 int i;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
129 /* If the target is MULTIPLE, then target_type looks like
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
130 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
131 We modify the second element of each pair in the vector and
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
132 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
133 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
134 for (i = 0; i < len; i++)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
135 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
136 Lisp_Object pair = XVECTOR_DATA (pairs) [i];
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
137 XVECTOR_DATA (pair) [1] =
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
138 x_get_local_selection (XVECTOR_DATA (pair) [0],
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
139 XVECTOR_DATA (pair) [1]);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
140 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
141 return pairs;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
142 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
143 #endif
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
144 else
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
145 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
146 CHECK_SYMBOL (target_type);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
147 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
148 if (NILP (handler_fn)) return Qnil;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
149 value = call3 (handler_fn,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
150 selection_symbol, target_type,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
151 XCAR (XCDR (local_value)));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
152 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
153
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
154 /* This lets the selection function to return (TYPE . VALUE). For example,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
155 when the selected type is LINE_NUMBER, the returned type is SPAN, not
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
156 INTEGER.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
157 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
158 check = value;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
159 if (CONSP (value) && SYMBOLP (XCAR (value)))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
160 check = XCDR (value);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
161
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
162 /* Strings, vectors, and symbols are converted to selection data format in
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
163 the obvious way. Integers are converted to 16 bit quantities if they're
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
164 small enough, otherwise 32 bits are used.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
165 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
166 if (STRINGP (check) ||
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
167 VECTORP (check) ||
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
168 SYMBOLP (check) ||
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
169 INTP (check) ||
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
170 CHARP (check) ||
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
171 NILP (value))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
172 return value;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
173
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
174 /* (N . M) or (N M) get turned into a 32 bit quantity. So if you want to
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
175 always return a small quantity as 32 bits, your converter routine needs
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
176 to return a cons.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
177 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
178 else if (CONSP (check) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
179 INTP (XCAR (check)) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
180 (INTP (XCDR (check)) ||
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
181 (CONSP (XCDR (check)) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
182 INTP (XCAR (XCDR (check))) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
183 NILP (XCDR (XCDR (check))))))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
184 return value;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
185 /* Otherwise the lisp converter function returned something unrecognized.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
186 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
187 else
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
188 signal_error (Qerror,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
189 list3 (build_string
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
190 ("unrecognized selection-conversion type"),
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
191 handler_fn,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
192 value));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
193
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
194 return Qnil; /* suppress compiler warning */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
195 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
196
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
197 DEFUN ("own-selection-internal", Fown_selection_internal, 2, 3, 0, /*
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
198 Assert a selection of the given TYPE with the given VALUE.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
199 TYPE is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
200 VALUE is typically a string, or a cons of two markers, but may be
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
201 anything that the functions on selection-converter-alist know about.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
202 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
203 (selection_name, selection_value, device))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
204 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
205 Lisp_Object selection_time, selection_data, prev_value;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 414
diff changeset
206 struct gcpro gcpro1;
414
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
207
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
208 CHECK_SYMBOL (selection_name);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
209 if (NILP (selection_value)) error ("selection-value may not be nil.");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
210
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
211 if (NILP (device))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
212 device = Fselected_device (Qnil);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
213
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
214 /* Now update the local cache */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
215 selection_data = list3 (selection_name,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
216 selection_value,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
217 Qnil);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 414
diff changeset
218 GCPRO1 (selection_data);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 414
diff changeset
219
414
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
220 prev_value = assq_no_quit (selection_name, Vselection_alist);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
221 Vselection_alist = Fcons (selection_data, Vselection_alist);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
222
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
223 /* If we already owned the selection, remove the old selection data.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
224 Perhaps we should destructively modify it instead.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
225 Don't use Fdelq() as that may QUIT;.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
226 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
227 if (!NILP (prev_value))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
228 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
229 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
230 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
231 if (EQ (prev_value, Fcar (XCDR (rest))))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
232 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
233 XCDR (rest) = Fcdr (XCDR (rest));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
234 break;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
235 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
236 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
237
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
238 /* have to do device specific stuff last so that methods can access the
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
239 selection_alist */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
240 if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
241 selection_time = DEVMETH (XDEVICE (device), own_selection,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
242 (selection_name, selection_value));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
243 else
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
244 selection_time = Qnil;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
245
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
246 Fsetcar (XCDR (XCDR (selection_data)), selection_time);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
247
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 414
diff changeset
248 UNGCPRO;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 414
diff changeset
249
414
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
250 return selection_value;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
251 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
252
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
253 /* remove a selection from our local copy
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
254 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
255 void
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
256 handle_selection_clear (Lisp_Object selection_symbol)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
257 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
258 Lisp_Object local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
259
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
260 /* Well, we already believe that we don't own it, so that's just fine. */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
261 if (NILP (local_selection_data)) return;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
262
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
263 /* Otherwise, we're really honest and truly being told to drop it.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
264 Don't use Fdelq() as that may QUIT;.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
265 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
266 if (EQ (local_selection_data, Fcar (Vselection_alist)))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
267 Vselection_alist = Fcdr (Vselection_alist);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
268 else
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
269 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
270 Lisp_Object rest;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
271 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
272 if (EQ (local_selection_data, Fcar (XCDR (rest))))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
273 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
274 XCDR (rest) = Fcdr (XCDR (rest));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
275 break;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
276 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
277 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
278
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
279 /* Let random lisp code notice that the selection has been stolen.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
280 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
281 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
282 Lisp_Object rest;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
283 Lisp_Object val = Vlost_selection_hooks;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
284 if (!UNBOUNDP (val) && !NILP (val))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
285 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
286 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
287 for (rest = val; !NILP (rest); rest = Fcdr (rest))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
288 call1 (Fcar (rest), selection_symbol);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
289 else
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
290 call1 (val, selection_symbol);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
291 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
292 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
293 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
294
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
295 DEFUN ("disown-selection-internal", Fdisown_selection_internal, 1, 3, 0, /*
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
296 If we own the named selection, then disown it (make there be no selection).
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
297 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
298 (selection_name, selection_time, device))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
299 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
300 if (NILP (assq_no_quit (selection_name, Vselection_alist)))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
301 return Qnil; /* Don't disown the selection when we're not the owner. */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
302
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
303 if (NILP (device))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
304 device = Fselected_device (Qnil);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
305
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
306 MAYBE_DEVMETH (XDEVICE (device), disown_selection,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
307 (selection_name, selection_time));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
308
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
309 handle_selection_clear (selection_name);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
310
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
311 return Qt;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
312 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
313
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
314 DEFUN ("selection-owner-p", Fselection_owner_p, 0, 1, 0, /*
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
315 Return t if current emacs process owns the given Selection.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
316 The arg should be the name of the selection in question, typically one of
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
317 the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
318 nil is the same as PRIMARY, and t is the same as SECONDARY.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
319 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
320 (selection))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
321 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
322 CHECK_SYMBOL (selection);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
323 if (EQ (selection, Qnil)) selection = QPRIMARY;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
324 else if (EQ (selection, Qt)) selection = QSECONDARY;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
325
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
326 return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
327 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
328
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
329 DEFUN ("selection-exists-p", Fselection_exists_p, 0, 2, 0, /*
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
330 Whether there is an owner for the given Selection.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
331 The arg should be the name of the selection in question, typically one of
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
332 the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
333 nil is the same as PRIMARY, and t is the same as SECONDARY.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
334 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
335 (selection, device))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
336 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
337 CHECK_SYMBOL (selection);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
338 if (!NILP (Fselection_owner_p (selection)))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
339 return Qt;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
340
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
341 if (NILP (device))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
342 device = Fselected_device (Qnil);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
343
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
344 return HAS_DEVMETH_P (XDEVICE (device), selection_exists_p) ?
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
345 DEVMETH (XDEVICE (device), selection_exists_p, (selection))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
346 : Qnil;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
347 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
348
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
349 /* Request the selection value from the owner. If we are the owner,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
350 simply return our selection value. If we are not the owner, this
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
351 will block until all of the data has arrived.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
352 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
353 DEFUN ("get-selection-internal", Fget_selection_internal, 2, 3, 0, /*
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
354 Return text selected from some window-system window.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
355 SELECTION_SYMBOL is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
356 TARGET_TYPE is the type of data desired, typically STRING or COMPOUND_TEXT.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
357 Under Mule, if the resultant data comes back as 8-bit data in type
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
358 TEXT or COMPOUND_TEXT, it will be decoded as Compound Text.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
359 */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
360 (selection_symbol, target_type, device))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
361 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
362 /* This function can GC */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
363 Lisp_Object val = Qnil;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
364 struct gcpro gcpro1, gcpro2;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
365 GCPRO2 (target_type, val); /* we store newly consed data into these */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
366 CHECK_SYMBOL (selection_symbol);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
367
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
368 if (NILP (device))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
369 device = Fselected_device (Qnil);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
370
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
371 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
372 if (CONSP (target_type) &&
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
373 XCAR (target_type) == QMULTIPLE)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
374 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
375 CHECK_VECTOR (XCDR (target_type));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
376 /* So we don't destructively modify this... */
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
377 target_type = copy_multiple_data (target_type);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
378 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
379 else
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
380 #endif
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
381 CHECK_SYMBOL (target_type);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
382
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
383 val = get_local_selection (selection_symbol, target_type);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
384
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
385 if (NILP (val) && (HAS_DEVMETH_P (XDEVICE (device), get_foreign_selection)))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
386 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
387 val = DEVMETH (XDEVICE (device), get_foreign_selection,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
388 (selection_symbol, target_type));
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
389 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
390 else
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
391 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
392 if (CONSP (val) && SYMBOLP (XCAR (val)))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
393 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
394 val = XCDR (val);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
395 if (CONSP (val) && NILP (XCDR (val)))
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
396 val = XCAR (val);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
397 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
398 val = clean_local_selection_data (val);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
399 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
400 UNGCPRO;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
401 return val;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
402 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
403
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
404 void
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
405 syms_of_select (void)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
406 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
407 DEFSUBR (Fown_selection_internal);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
408 DEFSUBR (Fget_selection_internal);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
409 DEFSUBR (Fselection_exists_p);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
410 DEFSUBR (Fdisown_selection_internal);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
411 DEFSUBR (Fselection_owner_p);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
412
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
413 defsymbol (&QPRIMARY, "PRIMARY");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
414 defsymbol (&QSECONDARY, "SECONDARY");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
415 defsymbol (&QSTRING, "STRING");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
416 defsymbol (&QINTEGER, "INTEGER");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
417 defsymbol (&QCLIPBOARD, "CLIPBOARD");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
418 defsymbol (&QTIMESTAMP, "TIMESTAMP");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
419 defsymbol (&QTEXT, "TEXT");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
420 defsymbol (&QDELETE, "DELETE");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
421 defsymbol (&QMULTIPLE, "MULTIPLE");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
422 defsymbol (&QINCR, "INCR");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
423 defsymbol (&QEMACS_TMP, "_EMACS_TMP_");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
424 defsymbol (&QTARGETS, "TARGETS");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
425 defsymbol (&QATOM, "ATOM");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
426 defsymbol (&QATOM_PAIR, "ATOM_PAIR");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
427 defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
428 defsymbol (&QNULL, "NULL");
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
429
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
430 deferror (&Qselection_conversion_error,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
431 "selection-conversion-error",
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
432 "selection-conversion error", Qio_error);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
433 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
434
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
435 void
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
436 vars_of_select (void)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
437 {
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
438 Vselection_alist = Qnil;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
439 staticpro (&Vselection_alist);
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
440
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
441 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist /*
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
442 An alist associating selection-types (such as STRING and TIMESTAMP) with
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
443 functions. These functions will be called with three args: the name
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
444 of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
445 desired type to which the selection should be converted; and the local
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
446 selection value (whatever had been passed to `own-selection'). For
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
447 historical reasons these functions should return the value to send to
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
448 an X server, which should be one of:
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
449
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
450 -- nil (the conversion could not be done)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
451 -- a cons of a symbol and any of the following values; the symbol
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
452 explicitly specifies the type that will be sent.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
453 -- a string (If the type is not specified, then if Mule support exists,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
454 the string will be converted to Compound Text and sent in
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
455 the 'COMPOUND_TEXT format; otherwise (no Mule support),
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
456 the string will be left as-is and sent in the 'STRING
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
457 format. If the type is specified, the string will be
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
458 left as-is (or converted to binary format under Mule).
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
459 In all cases, 8-bit data it sent.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
460 -- a character (With Mule support, will be converted to Compound Text
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
461 whether or not a type is specified. If a type is not
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
462 specified, a type of 'STRING or 'COMPOUND_TEXT will be
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
463 sent, as for strings.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
464 -- the symbol 'NULL (Indicates that there is no meaningful return value.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
465 Empty 32-bit data with a type of 'NULL will be sent.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
466 -- a symbol (Will be converted into an atom. If the type is not specified,
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
467 a type of 'ATOM will be sent.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
468 -- an integer (Will be converted into a 16-bit or 32-bit integer depending
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
469 on the value. If the type is not specified, a type of
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
470 'INTEGER will be sent.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
471 -- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
472 If the type is not specified, a type of
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
473 'INTEGER will be sent.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
474 -- a vector of symbols (Will be converted into a list of atoms. If the type
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
475 is not specified, a type of 'ATOM will be sent.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
476 -- a vector of integers (Will be converted into a list of 16-bit integers.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
477 If the type is not specified, a type of 'INTEGER
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
478 will be sent.)
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
479 -- a vector of integers and/or conses (HIGH . LOW) of integers
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
480 (Will be converted into a list of 16-bit integers.
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
481 If the type is not specified, a type of 'INTEGER
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
482 will be sent.) */ );
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
483 Vselection_converter_alist = Qnil;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
484
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
485 DEFVAR_LISP ("lost-selection-hooks", &Vlost_selection_hooks /*
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
486 A function or functions to be called after we have been notified
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
487 that we have lost the selection. The function(s) will be called with one
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
488 argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
489 CLIPBOARD).
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
490 */ );
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
491 Vlost_selection_hooks = Qunbound;
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
492 }
da8ed4261e83 Import from CVS: tag r21-2-15
cvs
parents:
diff changeset
493