*** empty log message ***
[bpt/emacs.git] / src / w32select.c
CommitLineData
e9e23e23 1/* Selection processing for Emacs on the Microsoft W32 API.
ee78dc32
GV
2 Copyright (C) 1993, 1994 Free Software Foundation.
3
3b7ad313
EN
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
ee78dc32
GV
20
21/* Written by Kevin Gallo */
22
23#include <config.h>
24#include "lisp.h"
fbd6baed 25#include "w32term.h" /* for all of the w32 includes */
ee78dc32 26#include "dispextern.h" /* frame.h seems to want this */
3e4731a3 27#include "keyboard.h"
ee78dc32
GV
28#include "frame.h" /* Need this to get the X window of selected_frame */
29#include "blockinput.h"
bbb059f3
AI
30#include "buffer.h"
31#include "charset.h"
32#include "coding.h"
ee78dc32 33
9aa94bd5
KH
34Lisp_Object QCLIPBOARD;
35
bbb059f3
AI
36/* Coding system for communicating with other Windows programs via the
37 clipboard. */
72aca5fa 38static Lisp_Object Vselection_coding_system;
bbb059f3 39
93cbf229
GV
40/* Coding system for the next communicating with other X clients. */
41static Lisp_Object Vnext_selection_coding_system;
42
ee78dc32 43#if 0
fbd6baed 44DEFUN ("w32-open-clipboard", Fw32_open_clipboard, Sw32_open_clipboard, 0, 1, 0,
ee78dc32
GV
45 "This opens the clipboard with the given frame pointer.")
46 (frame)
47 Lisp_Object frame;
48{
49 BOOL ok = FALSE;
50
51 if (!NILP (frame))
52 CHECK_LIVE_FRAME (frame, 0);
53
54 BLOCK_INPUT;
55
fbd6baed 56 ok = OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL);
ee78dc32
GV
57
58 UNBLOCK_INPUT;
59
60 return (ok ? frame : Qnil);
61}
62
fbd6baed 63DEFUN ("w32-empty-clipboard", Fw32_empty_clipboard, Sw32_empty_clipboard, 0, 0, 0,
ee78dc32
GV
64 "This empties the clipboard and assigns ownership to the window which opened the clipboard.")
65 ()
66{
67 BOOL ok = FALSE;
68
69 BLOCK_INPUT;
70
71 ok = EmptyClipboard ();
72
73 UNBLOCK_INPUT;
74
75 return (ok ? Qt : Qnil);
76}
77
fbd6baed 78DEFUN ("w32-close-clipboard", Fw32_close_clipboard, Sw32_close_clipboard, 0, 0, 0,
ee78dc32
GV
79 "This closes the clipboard.")
80 ()
81{
82 BOOL ok = FALSE;
83
84 BLOCK_INPUT;
85
86 ok = CloseClipboard ();
87
88 UNBLOCK_INPUT;
89
90 return (ok ? Qt : Qnil);
91}
92
93#endif
94
fbd6baed 95DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, Sw32_set_clipboard_data, 1, 2, 0,
ee78dc32
GV
96 "This sets the clipboard data to the given text.")
97 (string, frame)
98 Lisp_Object string, frame;
99{
100 BOOL ok = TRUE;
101 HANDLE htext;
69cddef0 102 int nbytes;
0ece9ef6 103 int truelen, nlines = 0;
69cddef0
GV
104 unsigned char *src;
105 unsigned char *dst;
0ece9ef6 106
ee78dc32
GV
107 CHECK_STRING (string, 0);
108
109 if (!NILP (frame))
110 CHECK_LIVE_FRAME (frame, 0);
111
112 BLOCK_INPUT;
69cddef0 113
bbb059f3 114 nbytes = STRING_BYTES (XSTRING (string)) + 1;
69cddef0 115 src = XSTRING (string)->data;
0ece9ef6
AI
116 dst = src;
117
118 /* We need to know how many lines there are, since we need CRLF line
119 termination for compatibility with other Windows Programs.
120 avoid using strchr because it recomputes the length every time */
121 while ((dst = memchr (dst, '\n', nbytes - (dst - src))) != NULL)
122 {
123 nlines++;
124 dst++;
125 }
69cddef0 126
bbb059f3
AI
127 {
128 /* Since we are now handling multilingual text, we must consider
129 encoding text for the clipboard. */
69ebbf81 130 int charset_info = find_charset_in_text (src, XSTRING (string)->size,
11f292ed 131 nbytes, NULL, Qnil);
bbb059f3 132
69ebbf81 133 if (charset_info == 0)
bbb059f3
AI
134 {
135 /* No multibyte character in OBJ. We need not encode it. */
69cddef0 136
c0ca703b 137 /* Need to know final size after CR chars are inserted (the
bbb059f3 138 standard CF_TEXT clipboard format uses CRLF line endings,
c0ca703b 139 while Emacs uses just LF internally). */
69cddef0 140
0ece9ef6 141 truelen = nbytes + nlines;
69cddef0 142
bbb059f3
AI
143 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
144 goto error;
145
146 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
147 goto error;
ee78dc32 148
bbb059f3
AI
149 /* convert to CRLF line endings expected by clipboard */
150 while (1)
151 {
152 unsigned char *next;
153 /* copy next line or remaining bytes including '\0' */
154 next = _memccpy (dst, src, '\n', nbytes);
155 if (next)
156 {
157 /* copied one line ending with '\n' */
158 int copied = next - dst;
159 nbytes -= copied;
160 src += copied;
161 /* insert '\r' before '\n' */
162 next[-1] = '\r';
163 next[0] = '\n';
164 dst = next + 1;
165 }
166 else
167 /* copied remaining partial line -> now finished */
168 break;
169 }
ee78dc32 170
bbb059f3 171 GlobalUnlock (htext);
0108f679
AI
172
173 Vlast_coding_system_used = Qraw_text;
bbb059f3
AI
174 }
175 else
176 {
177 /* We must encode contents of OBJ to compound text format.
178 The format is compatible with what the target `STRING'
179 expects if OBJ contains only ASCII and Latin-1
180 characters. */
181 int bufsize;
182 struct coding_system coding;
183 HANDLE htext2;
184
93cbf229
GV
185 if (NILP (Vnext_selection_coding_system))
186 Vnext_selection_coding_system = Vselection_coding_system;
bbb059f3 187 setup_coding_system
93cbf229 188 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
69ebbf81
KH
189 coding.src_multibyte = 1;
190 coding.dst_multibyte = 0;
93cbf229 191 Vnext_selection_coding_system = Qnil;
bbb059f3 192 coding.mode |= CODING_MODE_LAST_BLOCK;
43df7d0b 193 bufsize = encoding_buffer_size (&coding, nbytes);
bbb059f3
AI
194 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize)) == NULL)
195 goto error;
196 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
197 goto error;
198 encode_coding (&coding, src, dst, nbytes, bufsize);
0108f679 199 Vlast_coding_system_used = coding.symbol;
bbb059f3
AI
200 GlobalUnlock (htext);
201 /* Shrink data block to actual size. */
202 htext2 = GlobalReAlloc (htext, coding.produced, GMEM_MOVEABLE | GMEM_DDESHARE);
203 if (htext2 != NULL) htext = htext2;
204 }
205 }
ee78dc32 206
fbd6baed 207 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
ee78dc32
GV
208 goto error;
209
210 ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext);
211
212 CloseClipboard ();
213
214 if (ok) goto done;
215
216 error:
217
218 ok = FALSE;
219 if (htext) GlobalFree (htext);
220
221 done:
222 UNBLOCK_INPUT;
223
224 return (ok ? string : Qnil);
225}
226
fbd6baed 227DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, Sw32_get_clipboard_data, 0, 1, 0,
ee78dc32
GV
228 "This gets the clipboard data in text format.")
229 (frame)
230 Lisp_Object frame;
231{
232 HANDLE htext;
233 Lisp_Object ret = Qnil;
234
235 if (!NILP (frame))
236 CHECK_LIVE_FRAME (frame, 0);
237
238 BLOCK_INPUT;
239
fbd6baed 240 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
ee78dc32
GV
241 goto done;
242
243 if ((htext = GetClipboardData (CF_TEXT)) == NULL)
244 goto closeclip;
245
ee78dc32 246 {
69cddef0
GV
247 unsigned char *src;
248 unsigned char *dst;
ee78dc32 249 int nbytes;
69cddef0 250 int truelen;
c0ca703b 251 int require_decoding = 0;
ee78dc32 252
69cddef0 253 if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
ee78dc32
GV
254 goto closeclip;
255
69cddef0
GV
256 nbytes = strlen (src);
257
93cbf229
GV
258 if (
259#if 1
260 1
261#else
262 ! NILP (buffer_defaults.enable_multibyte_characters)
263#endif
264 )
265 {
c0ca703b 266 /* If the clipboard data contains any non-ascii code, we
93cbf229
GV
267 need to decode it. */
268 int i;
269
270 for (i = 0; i < nbytes; i++)
271 {
272 if (src[i] >= 0x80)
273 {
c0ca703b 274 require_decoding = 1;
93cbf229
GV
275 break;
276 }
277 }
278 }
279
c0ca703b 280 if (require_decoding)
69cddef0 281 {
bbb059f3
AI
282 int bufsize;
283 unsigned char *buf;
284 struct coding_system coding;
285
93cbf229
GV
286 if (NILP (Vnext_selection_coding_system))
287 Vnext_selection_coding_system = Vselection_coding_system;
bbb059f3 288 setup_coding_system
93cbf229 289 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
69ebbf81
KH
290 coding.src_multibyte = 0;
291 coding.dst_multibyte = 1;
93cbf229 292 Vnext_selection_coding_system = Qnil;
bbb059f3
AI
293 coding.mode |= CODING_MODE_LAST_BLOCK;
294 bufsize = decoding_buffer_size (&coding, nbytes);
295 buf = (unsigned char *) xmalloc (bufsize);
296 decode_coding (&coding, src, buf, nbytes, bufsize);
0108f679 297 Vlast_coding_system_used = coding.symbol;
69ebbf81
KH
298 ret = make_string_from_bytes ((char *) buf,
299 coding.produced_char, coding.produced);
bbb059f3 300 xfree (buf);
69cddef0 301 }
bbb059f3
AI
302 else
303 {
c0ca703b
GV
304 /* Need to know final size after CR chars are removed because we
305 can't change the string size manually, and doing an extra
306 copy is silly. Note that we only remove CR when it appears
307 as part of CRLF. */
bbb059f3
AI
308
309 truelen = nbytes;
310 dst = src;
311 /* avoid using strchr because it recomputes the length everytime */
312 while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL)
313 {
c0ca703b
GV
314 if (dst[1] == '\n') /* safe because of trailing '\0' */
315 truelen--;
bbb059f3
AI
316 dst++;
317 }
69cddef0 318
bbb059f3 319 ret = make_uninit_string (truelen);
69cddef0 320
c0ca703b
GV
321 /* Convert CRLF line endings (the standard CF_TEXT clipboard
322 format) to LF endings as used internally by Emacs. */
69cddef0 323
bbb059f3
AI
324 dst = XSTRING (ret)->data;
325 while (1)
69cddef0 326 {
bbb059f3
AI
327 unsigned char *next;
328 /* copy next line or remaining bytes excluding '\0' */
329 next = _memccpy (dst, src, '\r', nbytes);
330 if (next)
331 {
332 /* copied one line ending with '\r' */
333 int copied = next - dst;
334 nbytes -= copied;
c0ca703b 335 dst += copied;
bbb059f3 336 src += copied;
c0ca703b
GV
337 if (*src == '\n')
338 dst--; /* overwrite '\r' with '\n' */
339 }
bbb059f3
AI
340 else
341 /* copied remaining partial line -> now finished */
342 break;
343 }
0108f679
AI
344
345 Vlast_coding_system_used = Qraw_text;
69cddef0
GV
346 }
347
ee78dc32
GV
348 GlobalUnlock (htext);
349 }
350
351 closeclip:
352 CloseClipboard ();
353
354 done:
355 UNBLOCK_INPUT;
356
357 return (ret);
358}
359
9aa94bd5
KH
360/* Support checking for a clipboard selection. */
361
362DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
363 0, 1, 0,
364 "Whether there is an owner for the given X Selection.\n\
365The arg should be the name of the selection in question, typically one of\n\
366the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
367\(Those are literal upper-case symbol names, since that's what X expects.)\n\
368For convenience, the symbol nil is the same as `PRIMARY',\n\
369and t is the same as `SECONDARY'.")
370 (selection)
371 Lisp_Object selection;
372{
373 CHECK_SYMBOL (selection, 0);
374
375 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
376 if the clipboard currently has valid text format contents. */
377
378 if (EQ (selection, QCLIPBOARD))
379 {
380 Lisp_Object val = Qnil;
381
382 if (OpenClipboard (NULL))
383 {
384 int format = 0;
385 while (format = EnumClipboardFormats (format))
386 if (format == CF_TEXT)
387 {
388 val = Qt;
389 break;
390 }
391 CloseClipboard ();
392 }
393 return val;
394 }
395 return Qnil;
396}
397
ee78dc32 398void
fbd6baed 399syms_of_w32select ()
ee78dc32
GV
400{
401#if 0
fbd6baed
GV
402 defsubr (&Sw32_open_clipboard);
403 defsubr (&Sw32_empty_clipboard);
404 defsubr (&Sw32_close_clipboard);
ee78dc32 405#endif
fbd6baed
GV
406 defsubr (&Sw32_set_clipboard_data);
407 defsubr (&Sw32_get_clipboard_data);
9aa94bd5
KH
408 defsubr (&Sx_selection_exists_p);
409
72aca5fa 410 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
bbb059f3
AI
411 "Coding system for communicating with other X clients.\n\
412When sending or receiving text via cut_buffer, selection, and clipboard,\n\
413the text is encoded or decoded by this coding system.\n\
414A default value is `compound-text'");
72aca5fa 415 Vselection_coding_system=intern ("iso-latin-1-dos");
bbb059f3 416
93cbf229
GV
417 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
418 "Coding system for the next communication with other X clients.\n\
419Usually, `selection-coding-system' is used for communicating with\n\
420other X clients. But, if this variable is set, it is used for the\n\
421next communication only. After the communication, this variable is\n\
422set to nil.");
423 Vnext_selection_coding_system = Qnil;
424
9aa94bd5 425 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
ee78dc32 426}