(f90-looking-at-where-or-forall): Oops, defsubst, not defun.
[emacs.git] / src / w32select.c
blobfa37bd659262d54f8e646b795a6e5cbe455caca2
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 doc: /* 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);
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,
73 Sw32_empty_clipboard, 0, 0, 0,
74 doc: /* Empty the clipboard.
75 Assigns ownership of the clipboard to the window which opened it. */)
78 BOOL ok = FALSE;
80 BLOCK_INPUT;
82 ok = EmptyClipboard ();
84 UNBLOCK_INPUT;
86 return (ok ? Qt : Qnil);
89 DEFUN ("w32-close-clipboard", Fw32_close_clipboard,
90 Sw32_close_clipboard, 0, 0, 0,
91 doc: /* Close the clipboard. */)
94 BOOL ok = FALSE;
96 BLOCK_INPUT;
98 ok = CloseClipboard ();
100 UNBLOCK_INPUT;
102 return (ok ? Qt : Qnil);
105 #endif
107 DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data,
108 Sw32_set_clipboard_data, 1, 2, 0,
109 doc: /* This sets the clipboard data to the given text. */)
110 (string, frame)
111 Lisp_Object string, frame;
113 BOOL ok = TRUE;
114 HANDLE htext;
115 int nbytes;
116 int truelen, nlines = 0;
117 unsigned char *src;
118 unsigned char *dst;
120 CHECK_STRING (string);
122 if (!NILP (frame))
123 CHECK_LIVE_FRAME (frame);
125 BLOCK_INPUT;
127 nbytes = STRING_BYTES (XSTRING (string)) + 1;
128 src = XSTRING (string)->data;
129 dst = src;
131 /* We need to know how many lines there are, since we need CRLF line
132 termination for compatibility with other Windows Programs.
133 avoid using strchr because it recomputes the length every time */
134 while ((dst = memchr (dst, '\n', nbytes - (dst - src))) != NULL)
136 nlines++;
137 dst++;
141 /* Since we are now handling multilingual text, we must consider
142 encoding text for the clipboard. */
143 int charset_info = find_charset_in_text (src, XSTRING (string)->size,
144 nbytes, NULL, Qnil);
146 if (charset_info == 0)
148 /* No multibyte character in OBJ. We need not encode it. */
150 /* Need to know final size after CR chars are inserted (the
151 standard CF_TEXT clipboard format uses CRLF line endings,
152 while Emacs uses just LF internally). */
154 truelen = nbytes + nlines;
156 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
157 goto error;
159 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
160 goto error;
162 /* convert to CRLF line endings expected by clipboard */
163 while (1)
165 unsigned char *next;
166 /* copy next line or remaining bytes including '\0' */
167 next = _memccpy (dst, src, '\n', nbytes);
168 if (next)
170 /* copied one line ending with '\n' */
171 int copied = next - dst;
172 nbytes -= copied;
173 src += copied;
174 /* insert '\r' before '\n' */
175 next[-1] = '\r';
176 next[0] = '\n';
177 dst = next + 1;
179 else
180 /* copied remaining partial line -> now finished */
181 break;
184 GlobalUnlock (htext);
186 Vlast_coding_system_used = Qraw_text;
188 else
190 /* We must encode contents of OBJ to the selection coding
191 system. */
192 int bufsize;
193 struct coding_system coding;
194 HANDLE htext2;
196 if (NILP (Vnext_selection_coding_system))
197 Vnext_selection_coding_system = Vselection_coding_system;
198 setup_coding_system
199 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
200 if (SYMBOLP (coding.pre_write_conversion)
201 && !NILP (Ffboundp (coding.pre_write_conversion)))
203 string = run_pre_post_conversion_on_str (string, &coding, 1);
204 src = XSTRING (string)->data;
205 nbytes = STRING_BYTES (XSTRING (string));
207 coding.src_multibyte = 1;
208 coding.dst_multibyte = 0;
209 Vnext_selection_coding_system = Qnil;
210 coding.mode |= CODING_MODE_LAST_BLOCK;
211 bufsize = encoding_buffer_size (&coding, nbytes);
212 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize)) == NULL)
213 goto error;
214 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
215 goto error;
216 encode_coding (&coding, src, dst, nbytes, bufsize);
217 Vlast_coding_system_used = coding.symbol;
219 /* Stash away the data we are about to put into the clipboard, so we
220 could later check inside Fw32_get_clipboard_data whether
221 the clipboard still holds our data. */
222 if (clipboard_storage_size < coding.produced)
224 clipboard_storage_size = coding.produced + 100;
225 last_clipboard_text = (char *) xrealloc (last_clipboard_text,
226 clipboard_storage_size);
228 if (last_clipboard_text)
229 memcpy (last_clipboard_text, dst, coding.produced);
231 GlobalUnlock (htext);
233 /* Shrink data block to actual size. */
234 htext2 = GlobalReAlloc (htext, coding.produced,
235 GMEM_MOVEABLE | GMEM_DDESHARE);
236 if (htext2 != NULL) htext = htext2;
240 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
241 goto error;
243 ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext);
245 CloseClipboard ();
247 if (ok) goto done;
249 error:
251 ok = FALSE;
252 if (htext) GlobalFree (htext);
253 if (last_clipboard_text)
254 *last_clipboard_text = '\0';
256 done:
257 UNBLOCK_INPUT;
259 return (ok ? string : Qnil);
262 DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data,
263 Sw32_get_clipboard_data, 0, 1, 0,
264 doc: /* This gets the clipboard data in text format. */)
265 (frame)
266 Lisp_Object frame;
268 HANDLE htext;
269 Lisp_Object ret = Qnil;
271 if (!NILP (frame))
272 CHECK_LIVE_FRAME (frame);
274 BLOCK_INPUT;
276 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
277 goto done;
279 if ((htext = GetClipboardData (CF_TEXT)) == NULL)
280 goto closeclip;
283 unsigned char *src;
284 unsigned char *dst;
285 int nbytes;
286 int truelen;
287 int require_decoding = 0;
289 if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
290 goto closeclip;
292 nbytes = strlen (src);
294 /* If the text in clipboard is identical to what we put there
295 last time w32_set_clipboard_data was called, pretend there's no
296 data in the clipboard. This is so we don't pass our own text
297 from the clipboard (which might be troublesome if the killed
298 text includes null characters). */
299 if (last_clipboard_text
300 && clipboard_storage_size >= nbytes
301 && memcmp(last_clipboard_text, src, nbytes) == 0)
302 goto closeclip;
305 /* If the clipboard data contains any non-ascii code, we
306 need to decode it. */
307 int i;
309 for (i = 0; i < nbytes; i++)
311 if (src[i] >= 0x80)
313 require_decoding = 1;
314 break;
319 if (require_decoding)
321 int bufsize;
322 unsigned char *buf;
323 struct coding_system coding;
325 if (NILP (Vnext_selection_coding_system))
326 Vnext_selection_coding_system = Vselection_coding_system;
327 setup_coding_system
328 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
329 coding.src_multibyte = 0;
330 coding.dst_multibyte = 1;
331 Vnext_selection_coding_system = Qnil;
332 coding.mode |= CODING_MODE_LAST_BLOCK;
333 bufsize = decoding_buffer_size (&coding, nbytes);
334 buf = (unsigned char *) xmalloc (bufsize);
335 decode_coding (&coding, src, buf, nbytes, bufsize);
336 Vlast_coding_system_used = coding.symbol;
337 ret = make_string_from_bytes ((char *) buf,
338 coding.produced_char, coding.produced);
339 xfree (buf);
340 if (SYMBOLP (coding.post_read_conversion)
341 && !NILP (Ffboundp (coding.post_read_conversion)))
342 ret = run_pre_post_conversion_on_str (ret, &coding, 0);
344 else
346 /* Need to know final size after CR chars are removed because we
347 can't change the string size manually, and doing an extra
348 copy is silly. Note that we only remove CR when it appears
349 as part of CRLF. */
351 truelen = nbytes;
352 dst = src;
353 /* avoid using strchr because it recomputes the length everytime */
354 while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL)
356 if (dst[1] == '\n') /* safe because of trailing '\0' */
357 truelen--;
358 dst++;
361 ret = make_uninit_string (truelen);
363 /* Convert CRLF line endings (the standard CF_TEXT clipboard
364 format) to LF endings as used internally by Emacs. */
366 dst = XSTRING (ret)->data;
367 while (1)
369 unsigned char *next;
370 /* copy next line or remaining bytes excluding '\0' */
371 next = _memccpy (dst, src, '\r', nbytes);
372 if (next)
374 /* copied one line ending with '\r' */
375 int copied = next - dst;
376 nbytes -= copied;
377 dst += copied;
378 src += copied;
379 if (*src == '\n')
380 dst--; /* overwrite '\r' with '\n' */
382 else
383 /* copied remaining partial line -> now finished */
384 break;
387 Vlast_coding_system_used = Qraw_text;
390 GlobalUnlock (htext);
393 closeclip:
394 CloseClipboard ();
396 done:
397 UNBLOCK_INPUT;
399 return (ret);
402 /* Support checking for a clipboard selection. */
404 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
405 0, 1, 0,
406 doc: /* Whether there is an owner for the given X Selection.
407 The arg should be the name of the selection in question, typically one of
408 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
409 \(Those are literal upper-case symbol names, since that's what X expects.)
410 For convenience, the symbol nil is the same as `PRIMARY',
411 and t is the same as `SECONDARY'. */)
412 (selection)
413 Lisp_Object selection;
415 CHECK_SYMBOL (selection);
417 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
418 if the clipboard currently has valid text format contents. */
420 if (EQ (selection, QCLIPBOARD))
422 Lisp_Object val = Qnil;
424 if (OpenClipboard (NULL))
426 int format = 0;
427 while (format = EnumClipboardFormats (format))
428 if (format == CF_TEXT)
430 val = Qt;
431 break;
433 CloseClipboard ();
435 return val;
437 return Qnil;
440 void
441 syms_of_w32select ()
443 #if 0
444 defsubr (&Sw32_open_clipboard);
445 defsubr (&Sw32_empty_clipboard);
446 defsubr (&Sw32_close_clipboard);
447 #endif
448 defsubr (&Sw32_set_clipboard_data);
449 defsubr (&Sw32_get_clipboard_data);
450 defsubr (&Sx_selection_exists_p);
452 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
453 doc: /* Coding system for communicating with other programs.
454 When sending or receiving text via cut_buffer, selection, and clipboard,
455 the text is encoded or decoded by this coding system. */);
456 Vselection_coding_system=intern ("iso-latin-1-dos");
458 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
459 doc: /* Coding system for the next communication with other programs.
460 Usually, `selection-coding-system' is used for communicating with
461 other programs. But, if this variable is set, it is used for the
462 next communication only. After the communication, this variable is
463 set to nil. */);
464 Vnext_selection_coding_system = Qnil;
466 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);