(make_lispy_event): Add string info to the event,
[emacs/old-mirror.git] / src / w32select.c
blob520610ee9617467a5a779987c769b530b465b333
1 /* Selection processing for Emacs on the Microsoft W32 API.
2 Copyright (C) 1993, 1994 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Written by Kevin Gallo */
23 #include <config.h>
24 #include "lisp.h"
25 #include "w32term.h" /* for all of the w32 includes */
26 #include "dispextern.h" /* frame.h seems to want this */
27 #include "keyboard.h"
28 #include "frame.h" /* Need this to get the X window of selected_frame */
29 #include "blockinput.h"
30 #include "buffer.h"
31 #include "charset.h"
32 #include "coding.h"
34 Lisp_Object QCLIPBOARD;
36 /* Coding system for communicating with other Windows programs via the
37 clipboard. */
38 static Lisp_Object Vselection_coding_system;
40 /* Coding system for the next communicating with other Windows programs. */
41 static Lisp_Object Vnext_selection_coding_system;
43 /* The last text we put into the clipboard. This is used to prevent
44 passing back our own text from the clipboard, instead of using the
45 kill ring. The former is undesirable because the clipboard data
46 could be MULEtilated by inappropriately chosen
47 (next-)selection-coding-system. For this reason, we must store the
48 text *after* it was encoded/Unix-to-DOS-converted. */
49 static unsigned char *last_clipboard_text = NULL;
50 static size_t clipboard_storage_size = 0;
52 #if 0
53 DEFUN ("w32-open-clipboard", Fw32_open_clipboard, Sw32_open_clipboard, 0, 1, 0,
54 "This opens the clipboard with the given frame pointer.")
55 (frame)
56 Lisp_Object frame;
58 BOOL ok = FALSE;
60 if (!NILP (frame))
61 CHECK_LIVE_FRAME (frame, 0);
63 BLOCK_INPUT;
65 ok = OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL);
67 UNBLOCK_INPUT;
69 return (ok ? frame : Qnil);
72 DEFUN ("w32-empty-clipboard", Fw32_empty_clipboard, Sw32_empty_clipboard, 0, 0, 0,
73 "This empties the clipboard and assigns ownership to the window which opened the clipboard.")
76 BOOL ok = FALSE;
78 BLOCK_INPUT;
80 ok = EmptyClipboard ();
82 UNBLOCK_INPUT;
84 return (ok ? Qt : Qnil);
87 DEFUN ("w32-close-clipboard", Fw32_close_clipboard, Sw32_close_clipboard, 0, 0, 0,
88 "This closes the clipboard.")
91 BOOL ok = FALSE;
93 BLOCK_INPUT;
95 ok = CloseClipboard ();
97 UNBLOCK_INPUT;
99 return (ok ? Qt : Qnil);
102 #endif
104 DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, Sw32_set_clipboard_data, 1, 2, 0,
105 "This sets the clipboard data to the given text.")
106 (string, frame)
107 Lisp_Object string, frame;
109 BOOL ok = TRUE;
110 HANDLE htext;
111 int nbytes;
112 int truelen, nlines = 0;
113 unsigned char *src;
114 unsigned char *dst;
116 CHECK_STRING (string, 0);
118 if (!NILP (frame))
119 CHECK_LIVE_FRAME (frame, 0);
121 BLOCK_INPUT;
123 nbytes = STRING_BYTES (XSTRING (string)) + 1;
124 src = XSTRING (string)->data;
125 dst = src;
127 /* We need to know how many lines there are, since we need CRLF line
128 termination for compatibility with other Windows Programs.
129 avoid using strchr because it recomputes the length every time */
130 while ((dst = memchr (dst, '\n', nbytes - (dst - src))) != NULL)
132 nlines++;
133 dst++;
137 /* Since we are now handling multilingual text, we must consider
138 encoding text for the clipboard. */
139 int charset_info = find_charset_in_text (src, XSTRING (string)->size,
140 nbytes, NULL, Qnil);
142 if (charset_info == 0)
144 /* No multibyte character in OBJ. We need not encode it. */
146 /* Need to know final size after CR chars are inserted (the
147 standard CF_TEXT clipboard format uses CRLF line endings,
148 while Emacs uses just LF internally). */
150 truelen = nbytes + nlines;
152 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
153 goto error;
155 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
156 goto error;
158 /* convert to CRLF line endings expected by clipboard */
159 while (1)
161 unsigned char *next;
162 /* copy next line or remaining bytes including '\0' */
163 next = _memccpy (dst, src, '\n', nbytes);
164 if (next)
166 /* copied one line ending with '\n' */
167 int copied = next - dst;
168 nbytes -= copied;
169 src += copied;
170 /* insert '\r' before '\n' */
171 next[-1] = '\r';
172 next[0] = '\n';
173 dst = next + 1;
175 else
176 /* copied remaining partial line -> now finished */
177 break;
180 GlobalUnlock (htext);
182 Vlast_coding_system_used = Qraw_text;
184 else
186 /* We must encode contents of OBJ to the selection coding
187 system. */
188 int bufsize;
189 struct coding_system coding;
190 HANDLE htext2;
192 if (NILP (Vnext_selection_coding_system))
193 Vnext_selection_coding_system = Vselection_coding_system;
194 setup_coding_system
195 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
196 coding.src_multibyte = 1;
197 coding.dst_multibyte = 0;
198 Vnext_selection_coding_system = Qnil;
199 coding.mode |= CODING_MODE_LAST_BLOCK;
200 bufsize = encoding_buffer_size (&coding, nbytes);
201 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize)) == NULL)
202 goto error;
203 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
204 goto error;
205 encode_coding (&coding, src, dst, nbytes, bufsize);
206 Vlast_coding_system_used = coding.symbol;
208 /* Stash away the data we are about to put into the clipboard, so we
209 could later check inside Fw32_get_clipboard_data whether
210 the clipboard still holds our data. */
211 if (clipboard_storage_size < coding.produced)
213 clipboard_storage_size = coding.produced + 100;
214 last_clipboard_text = (char *) xrealloc (last_clipboard_text,
215 clipboard_storage_size);
217 if (last_clipboard_text)
218 memcpy (last_clipboard_text, dst, coding.produced);
220 GlobalUnlock (htext);
222 /* Shrink data block to actual size. */
223 htext2 = GlobalReAlloc (htext, coding.produced,
224 GMEM_MOVEABLE | GMEM_DDESHARE);
225 if (htext2 != NULL) htext = htext2;
229 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
230 goto error;
232 ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext);
234 CloseClipboard ();
236 if (ok) goto done;
238 error:
240 ok = FALSE;
241 if (htext) GlobalFree (htext);
242 if (last_clipboard_text)
243 *last_clipboard_text = '\0';
245 done:
246 UNBLOCK_INPUT;
248 return (ok ? string : Qnil);
251 DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, Sw32_get_clipboard_data, 0, 1, 0,
252 "This gets the clipboard data in text format.")
253 (frame)
254 Lisp_Object frame;
256 HANDLE htext;
257 Lisp_Object ret = Qnil;
259 if (!NILP (frame))
260 CHECK_LIVE_FRAME (frame, 0);
262 BLOCK_INPUT;
264 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
265 goto done;
267 if ((htext = GetClipboardData (CF_TEXT)) == NULL)
268 goto closeclip;
271 unsigned char *src;
272 unsigned char *dst;
273 int nbytes;
274 int truelen;
275 int require_decoding = 0;
277 if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
278 goto closeclip;
280 nbytes = strlen (src);
282 /* If the text in clipboard is identical to what we put there
283 last time w32_set_clipboard_data was called, pretend there's no
284 data in the clipboard. This is so we don't pass our own text
285 from the clipboard (which might be troublesome if the killed
286 text includes null characters). */
287 if (last_clipboard_text
288 && clipboard_storage_size >= nbytes
289 && memcmp(last_clipboard_text, src, nbytes) == 0)
290 goto closeclip;
292 if (
293 #if 1
295 #else
296 ! NILP (buffer_defaults.enable_multibyte_characters)
297 #endif
300 /* If the clipboard data contains any non-ascii code, we
301 need to decode it. */
302 int i;
304 for (i = 0; i < nbytes; i++)
306 if (src[i] >= 0x80)
308 require_decoding = 1;
309 break;
314 if (require_decoding)
316 int bufsize;
317 unsigned char *buf;
318 struct coding_system coding;
320 if (NILP (Vnext_selection_coding_system))
321 Vnext_selection_coding_system = Vselection_coding_system;
322 setup_coding_system
323 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
324 coding.src_multibyte = 0;
325 coding.dst_multibyte = 1;
326 Vnext_selection_coding_system = Qnil;
327 coding.mode |= CODING_MODE_LAST_BLOCK;
328 bufsize = decoding_buffer_size (&coding, nbytes);
329 buf = (unsigned char *) xmalloc (bufsize);
330 decode_coding (&coding, src, buf, nbytes, bufsize);
331 Vlast_coding_system_used = coding.symbol;
332 ret = make_string_from_bytes ((char *) buf,
333 coding.produced_char, coding.produced);
334 xfree (buf);
336 else
338 /* Need to know final size after CR chars are removed because we
339 can't change the string size manually, and doing an extra
340 copy is silly. Note that we only remove CR when it appears
341 as part of CRLF. */
343 truelen = nbytes;
344 dst = src;
345 /* avoid using strchr because it recomputes the length everytime */
346 while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL)
348 if (dst[1] == '\n') /* safe because of trailing '\0' */
349 truelen--;
350 dst++;
353 ret = make_uninit_string (truelen);
355 /* Convert CRLF line endings (the standard CF_TEXT clipboard
356 format) to LF endings as used internally by Emacs. */
358 dst = XSTRING (ret)->data;
359 while (1)
361 unsigned char *next;
362 /* copy next line or remaining bytes excluding '\0' */
363 next = _memccpy (dst, src, '\r', nbytes);
364 if (next)
366 /* copied one line ending with '\r' */
367 int copied = next - dst;
368 nbytes -= copied;
369 dst += copied;
370 src += copied;
371 if (*src == '\n')
372 dst--; /* overwrite '\r' with '\n' */
374 else
375 /* copied remaining partial line -> now finished */
376 break;
379 Vlast_coding_system_used = Qraw_text;
382 GlobalUnlock (htext);
385 closeclip:
386 CloseClipboard ();
388 done:
389 UNBLOCK_INPUT;
391 return (ret);
394 /* Support checking for a clipboard selection. */
396 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
397 0, 1, 0,
398 "Whether there is an owner for the given X Selection.\n\
399 The arg should be the name of the selection in question, typically one of\n\
400 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
401 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
402 For convenience, the symbol nil is the same as `PRIMARY',\n\
403 and t is the same as `SECONDARY'.")
404 (selection)
405 Lisp_Object selection;
407 CHECK_SYMBOL (selection, 0);
409 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
410 if the clipboard currently has valid text format contents. */
412 if (EQ (selection, QCLIPBOARD))
414 Lisp_Object val = Qnil;
416 if (OpenClipboard (NULL))
418 int format = 0;
419 while (format = EnumClipboardFormats (format))
420 if (format == CF_TEXT)
422 val = Qt;
423 break;
425 CloseClipboard ();
427 return val;
429 return Qnil;
432 void
433 syms_of_w32select ()
435 #if 0
436 defsubr (&Sw32_open_clipboard);
437 defsubr (&Sw32_empty_clipboard);
438 defsubr (&Sw32_close_clipboard);
439 #endif
440 defsubr (&Sw32_set_clipboard_data);
441 defsubr (&Sw32_get_clipboard_data);
442 defsubr (&Sx_selection_exists_p);
444 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
445 "Coding system for communicating with other X clients.\n\
446 When sending or receiving text via cut_buffer, selection, and clipboard,\n\
447 the text is encoded or decoded by this coding system.\n\
448 A default value is `compound-text'");
449 Vselection_coding_system=intern ("iso-latin-1-dos");
451 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
452 "Coding system for the next communication with other X clients.\n\
453 Usually, `selection-coding-system' is used for communicating with\n\
454 other X clients. But, if this variable is set, it is used for the\n\
455 next communication only. After the communication, this variable is\n\
456 set to nil.");
457 Vnext_selection_coding_system = Qnil;
459 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);