(scan_keyword_or_put_char, write_c_args): Use `fn'
[emacs.git] / src / w32select.c
blob1cb5838c6fc079dd634cc88389ca8c40ff648274
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"
33 #include "composite.h"
35 Lisp_Object QCLIPBOARD;
37 /* Coding system for communicating with other Windows programs via the
38 clipboard. */
39 static Lisp_Object Vselection_coding_system;
41 /* Coding system for the next communicating with other Windows programs. */
42 static Lisp_Object Vnext_selection_coding_system;
44 /* The last text we put into the clipboard. This is used to prevent
45 passing back our own text from the clipboard, instead of using the
46 kill ring. The former is undesirable because the clipboard data
47 could be MULEtilated by inappropriately chosen
48 (next-)selection-coding-system. For this reason, we must store the
49 text *after* it was encoded/Unix-to-DOS-converted. */
50 static unsigned char *last_clipboard_text = NULL;
51 static size_t clipboard_storage_size = 0;
53 #if 0
54 DEFUN ("w32-open-clipboard", Fw32_open_clipboard, Sw32_open_clipboard, 0, 1, 0,
55 doc: /* This opens the clipboard with the given frame pointer. */)
56 (frame)
57 Lisp_Object frame;
59 BOOL ok = FALSE;
61 if (!NILP (frame))
62 CHECK_LIVE_FRAME (frame);
64 BLOCK_INPUT;
66 ok = OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL);
68 UNBLOCK_INPUT;
70 return (ok ? frame : Qnil);
73 DEFUN ("w32-empty-clipboard", Fw32_empty_clipboard,
74 Sw32_empty_clipboard, 0, 0, 0,
75 doc: /* Empty the clipboard.
76 Assigns ownership of the clipboard to the window which opened it. */)
79 BOOL ok = FALSE;
81 BLOCK_INPUT;
83 ok = EmptyClipboard ();
85 UNBLOCK_INPUT;
87 return (ok ? Qt : Qnil);
90 DEFUN ("w32-close-clipboard", Fw32_close_clipboard,
91 Sw32_close_clipboard, 0, 0, 0,
92 doc: /* Close the clipboard. */)
95 BOOL ok = FALSE;
97 BLOCK_INPUT;
99 ok = CloseClipboard ();
101 UNBLOCK_INPUT;
103 return (ok ? Qt : Qnil);
106 #endif
108 DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data,
109 Sw32_set_clipboard_data, 1, 2, 0,
110 doc: /* This sets the clipboard data to the given text. */)
111 (string, frame)
112 Lisp_Object string, frame;
114 BOOL ok = TRUE;
115 HANDLE htext;
116 int nbytes;
117 int truelen, nlines = 0;
118 unsigned char *src;
119 unsigned char *dst;
121 CHECK_STRING (string);
123 if (!NILP (frame))
124 CHECK_LIVE_FRAME (frame);
126 BLOCK_INPUT;
128 nbytes = SBYTES (string) + 1;
129 src = SDATA (string);
130 dst = src;
132 /* We need to know how many lines there are, since we need CRLF line
133 termination for compatibility with other Windows Programs.
134 avoid using strchr because it recomputes the length every time */
135 while ((dst = memchr (dst, '\n', nbytes - (dst - src))) != NULL)
137 nlines++;
138 dst++;
142 /* Since we are now handling multilingual text, we must consider
143 encoding text for the clipboard. */
144 int charset_info = find_charset_in_text (src, SCHARS (string),
145 nbytes, NULL, Qnil);
147 if (charset_info == 0)
149 /* No multibyte character in OBJ. We need not encode it. */
151 /* Need to know final size after CR chars are inserted (the
152 standard CF_TEXT clipboard format uses CRLF line endings,
153 while Emacs uses just LF internally). */
155 truelen = nbytes + nlines;
157 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
158 goto error;
160 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
161 goto error;
163 /* convert to CRLF line endings expected by clipboard */
164 while (1)
166 unsigned char *next;
167 /* copy next line or remaining bytes including '\0' */
168 next = _memccpy (dst, src, '\n', nbytes);
169 if (next)
171 /* copied one line ending with '\n' */
172 int copied = next - dst;
173 nbytes -= copied;
174 src += copied;
175 /* insert '\r' before '\n' */
176 next[-1] = '\r';
177 next[0] = '\n';
178 dst = next + 1;
180 else
181 /* copied remaining partial line -> now finished */
182 break;
185 GlobalUnlock (htext);
187 Vlast_coding_system_used = Qraw_text;
189 else
191 /* We must encode contents of OBJ to the selection coding
192 system. */
193 int bufsize;
194 struct coding_system coding;
195 HANDLE htext2;
197 if (NILP (Vnext_selection_coding_system))
198 Vnext_selection_coding_system = Vselection_coding_system;
199 setup_coding_system
200 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
201 if (SYMBOLP (coding.pre_write_conversion)
202 && !NILP (Ffboundp (coding.pre_write_conversion)))
204 string = run_pre_post_conversion_on_str (string, &coding, 1);
205 src = SDATA (string);
206 nbytes = SBYTES (string);
208 coding.src_multibyte = 1;
209 coding.dst_multibyte = 0;
210 Vnext_selection_coding_system = Qnil;
211 coding.mode |= CODING_MODE_LAST_BLOCK;
212 bufsize = encoding_buffer_size (&coding, nbytes);
213 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize)) == NULL)
214 goto error;
215 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
216 goto error;
217 encode_coding (&coding, src, dst, nbytes, bufsize);
218 Vlast_coding_system_used = coding.symbol;
220 /* Stash away the data we are about to put into the clipboard, so we
221 could later check inside Fw32_get_clipboard_data whether
222 the clipboard still holds our data. */
223 if (clipboard_storage_size < coding.produced)
225 clipboard_storage_size = coding.produced + 100;
226 last_clipboard_text = (char *) xrealloc (last_clipboard_text,
227 clipboard_storage_size);
229 if (last_clipboard_text)
230 memcpy (last_clipboard_text, dst, coding.produced);
232 GlobalUnlock (htext);
234 /* Shrink data block to actual size. */
235 htext2 = GlobalReAlloc (htext, coding.produced,
236 GMEM_MOVEABLE | GMEM_DDESHARE);
237 if (htext2 != NULL) htext = htext2;
241 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
242 goto error;
244 ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext);
246 CloseClipboard ();
248 if (ok) goto done;
250 error:
252 ok = FALSE;
253 if (htext) GlobalFree (htext);
254 if (last_clipboard_text)
255 *last_clipboard_text = '\0';
257 done:
258 UNBLOCK_INPUT;
260 return (ok ? string : Qnil);
263 DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data,
264 Sw32_get_clipboard_data, 0, 1, 0,
265 doc: /* This gets the clipboard data in text format. */)
266 (frame)
267 Lisp_Object frame;
269 HANDLE htext;
270 Lisp_Object ret = Qnil;
272 if (!NILP (frame))
273 CHECK_LIVE_FRAME (frame);
275 BLOCK_INPUT;
277 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
278 goto done;
280 if ((htext = GetClipboardData (CF_TEXT)) == NULL)
281 goto closeclip;
284 unsigned char *src;
285 unsigned char *dst;
286 int nbytes;
287 int truelen;
288 int require_decoding = 0;
290 if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
291 goto closeclip;
293 nbytes = strlen (src);
295 /* If the text in clipboard is identical to what we put there
296 last time w32_set_clipboard_data was called, pretend there's no
297 data in the clipboard. This is so we don't pass our own text
298 from the clipboard (which might be troublesome if the killed
299 text includes null characters). */
300 if (last_clipboard_text
301 && clipboard_storage_size >= nbytes
302 && memcmp(last_clipboard_text, src, nbytes) == 0)
303 goto closeclip;
306 /* If the clipboard data contains any non-ascii code, we
307 need to decode it. */
308 int i;
310 for (i = 0; i < nbytes; i++)
312 if (src[i] >= 0x80)
314 require_decoding = 1;
315 break;
320 if (require_decoding)
322 int bufsize;
323 unsigned char *buf;
324 struct coding_system coding;
326 if (NILP (Vnext_selection_coding_system))
327 Vnext_selection_coding_system = Vselection_coding_system;
328 setup_coding_system
329 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
330 coding.src_multibyte = 0;
331 coding.dst_multibyte = 1;
332 Vnext_selection_coding_system = Qnil;
333 coding.mode |= CODING_MODE_LAST_BLOCK;
334 /* We explicitely disable composition handling because
335 selection data should not contain any composition
336 sequence. */
337 coding.composing = COMPOSITION_DISABLED;
338 bufsize = decoding_buffer_size (&coding, nbytes);
339 buf = (unsigned char *) xmalloc (bufsize);
340 decode_coding (&coding, src, buf, nbytes, bufsize);
341 Vlast_coding_system_used = coding.symbol;
342 ret = make_string_from_bytes ((char *) buf,
343 coding.produced_char, coding.produced);
344 xfree (buf);
345 if (SYMBOLP (coding.post_read_conversion)
346 && !NILP (Ffboundp (coding.post_read_conversion)))
347 ret = run_pre_post_conversion_on_str (ret, &coding, 0);
349 else
351 /* Need to know final size after CR chars are removed because we
352 can't change the string size manually, and doing an extra
353 copy is silly. Note that we only remove CR when it appears
354 as part of CRLF. */
356 truelen = nbytes;
357 dst = src;
358 /* avoid using strchr because it recomputes the length everytime */
359 while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL)
361 if (dst[1] == '\n') /* safe because of trailing '\0' */
362 truelen--;
363 dst++;
366 ret = make_uninit_string (truelen);
368 /* Convert CRLF line endings (the standard CF_TEXT clipboard
369 format) to LF endings as used internally by Emacs. */
371 dst = SDATA (ret);
372 while (1)
374 unsigned char *next;
375 /* copy next line or remaining bytes excluding '\0' */
376 next = _memccpy (dst, src, '\r', nbytes);
377 if (next)
379 /* copied one line ending with '\r' */
380 int copied = next - dst;
381 nbytes -= copied;
382 dst += copied;
383 src += copied;
384 if (*src == '\n')
385 dst--; /* overwrite '\r' with '\n' */
387 else
388 /* copied remaining partial line -> now finished */
389 break;
392 Vlast_coding_system_used = Qraw_text;
395 GlobalUnlock (htext);
398 closeclip:
399 CloseClipboard ();
401 done:
402 UNBLOCK_INPUT;
404 return (ret);
407 /* Support checking for a clipboard selection. */
409 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
410 0, 1, 0,
411 doc: /* Whether there is an owner for the given X Selection.
412 The arg should be the name of the selection in question, typically one of
413 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
414 \(Those are literal upper-case symbol names, since that's what X expects.)
415 For convenience, the symbol nil is the same as `PRIMARY',
416 and t is the same as `SECONDARY'. */)
417 (selection)
418 Lisp_Object selection;
420 CHECK_SYMBOL (selection);
422 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
423 if the clipboard currently has valid text format contents. */
425 if (EQ (selection, QCLIPBOARD))
427 Lisp_Object val = Qnil;
429 if (OpenClipboard (NULL))
431 int format = 0;
432 while (format = EnumClipboardFormats (format))
433 if (format == CF_TEXT)
435 val = Qt;
436 break;
438 CloseClipboard ();
440 return val;
442 return Qnil;
445 void
446 syms_of_w32select ()
448 #if 0
449 defsubr (&Sw32_open_clipboard);
450 defsubr (&Sw32_empty_clipboard);
451 defsubr (&Sw32_close_clipboard);
452 #endif
453 defsubr (&Sw32_set_clipboard_data);
454 defsubr (&Sw32_get_clipboard_data);
455 defsubr (&Sx_selection_exists_p);
457 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
458 doc: /* Coding system for communicating with other programs.
459 When sending or receiving text via cut_buffer, selection, and clipboard,
460 the text is encoded or decoded by this coding system. */);
461 Vselection_coding_system=intern ("iso-latin-1-dos");
463 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
464 doc: /* Coding system for the next communication with other programs.
465 Usually, `selection-coding-system' is used for communicating with
466 other programs. But, if this variable is set, it is used for the
467 next communication only. After the communication, this variable is
468 set to nil. */);
469 Vnext_selection_coding_system = Qnil;
471 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);