* subr.el (with-current-buffer): don't use backquotes to avoid
[emacs.git] / src / w32select.c
blob65db0b5458ea63f36c26fb9fd45cf9ba84dd10ef
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 "frame.h" /* Need this to get the X window of selected_frame */
28 #include "blockinput.h"
29 #include "buffer.h"
30 #include "charset.h"
31 #include "coding.h"
33 Lisp_Object QCLIPBOARD;
35 /* Coding system for communicating with other Windows programs via the
36 clipboard. */
37 static Lisp_Object Vselection_coding_system;
39 /* Coding system for the next communicating with other X clients. */
40 static Lisp_Object Vnext_selection_coding_system;
42 #if 0
43 DEFUN ("w32-open-clipboard", Fw32_open_clipboard, Sw32_open_clipboard, 0, 1, 0,
44 "This opens the clipboard with the given frame pointer.")
45 (frame)
46 Lisp_Object frame;
48 BOOL ok = FALSE;
50 if (!NILP (frame))
51 CHECK_LIVE_FRAME (frame, 0);
53 BLOCK_INPUT;
55 ok = OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL);
57 UNBLOCK_INPUT;
59 return (ok ? frame : Qnil);
62 DEFUN ("w32-empty-clipboard", Fw32_empty_clipboard, Sw32_empty_clipboard, 0, 0, 0,
63 "This empties the clipboard and assigns ownership to the window which opened the clipboard.")
66 BOOL ok = FALSE;
68 BLOCK_INPUT;
70 ok = EmptyClipboard ();
72 UNBLOCK_INPUT;
74 return (ok ? Qt : Qnil);
77 DEFUN ("w32-close-clipboard", Fw32_close_clipboard, Sw32_close_clipboard, 0, 0, 0,
78 "This closes the clipboard.")
81 BOOL ok = FALSE;
83 BLOCK_INPUT;
85 ok = CloseClipboard ();
87 UNBLOCK_INPUT;
89 return (ok ? Qt : Qnil);
92 #endif
94 DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, Sw32_set_clipboard_data, 1, 2, 0,
95 "This sets the clipboard data to the given text.")
96 (string, frame)
97 Lisp_Object string, frame;
99 BOOL ok = TRUE;
100 HANDLE htext;
101 int nbytes;
102 int truelen, nlines = 0;
103 unsigned char *src;
104 unsigned char *dst;
106 CHECK_STRING (string, 0);
108 if (!NILP (frame))
109 CHECK_LIVE_FRAME (frame, 0);
111 BLOCK_INPUT;
113 nbytes = STRING_BYTES (XSTRING (string)) + 1;
114 src = XSTRING (string)->data;
115 dst = src;
117 /* We need to know how many lines there are, since we need CRLF line
118 termination for compatibility with other Windows Programs.
119 avoid using strchr because it recomputes the length every time */
120 while ((dst = memchr (dst, '\n', nbytes - (dst - src))) != NULL)
122 nlines++;
123 dst++;
127 /* Since we are now handling multilingual text, we must consider
128 encoding text for the clipboard. */
129 int charsets[MAX_CHARSET + 1];
130 int num;
132 bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
133 num = ((nbytes <= 1 /* Check the possibility of short cut. */
134 || !STRING_MULTIBYTE (string)
135 || nbytes == XSTRING (string)->size)
137 : find_charset_in_str (src, nbytes, charsets, Qnil, 0, 1));
139 if (!num || (num == 1 && charsets[CHARSET_ASCII]))
141 /* No multibyte character in OBJ. We need not encode it. */
143 /* Need to know final size after CR chars are inserted (the
144 standard CF_TEXT clipboard format uses CRLF line endings,
145 while Emacs uses just LF internally). */
147 truelen = nbytes + nlines;
149 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
150 goto error;
152 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
153 goto error;
155 /* convert to CRLF line endings expected by clipboard */
156 while (1)
158 unsigned char *next;
159 /* copy next line or remaining bytes including '\0' */
160 next = _memccpy (dst, src, '\n', nbytes);
161 if (next)
163 /* copied one line ending with '\n' */
164 int copied = next - dst;
165 nbytes -= copied;
166 src += copied;
167 /* insert '\r' before '\n' */
168 next[-1] = '\r';
169 next[0] = '\n';
170 dst = next + 1;
172 else
173 /* copied remaining partial line -> now finished */
174 break;
177 GlobalUnlock (htext);
179 Vlast_coding_system_used = Qraw_text;
181 else
183 /* We must encode contents of OBJ to compound text format.
184 The format is compatible with what the target `STRING'
185 expects if OBJ contains only ASCII and Latin-1
186 characters. */
187 int bufsize;
188 struct coding_system coding;
189 HANDLE htext2;
191 if (NILP (Vnext_selection_coding_system))
192 Vnext_selection_coding_system = Vselection_coding_system;
193 setup_coding_system
194 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
195 Vnext_selection_coding_system = Qnil;
196 coding.mode |= CODING_MODE_LAST_BLOCK;
197 bufsize = encoding_buffer_size (&coding, nbytes);
198 if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize)) == NULL)
199 goto error;
200 if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
201 goto error;
202 encode_coding (&coding, src, dst, nbytes, bufsize);
203 Vlast_coding_system_used = coding.symbol;
204 GlobalUnlock (htext);
205 /* Shrink data block to actual size. */
206 htext2 = GlobalReAlloc (htext, coding.produced, GMEM_MOVEABLE | GMEM_DDESHARE);
207 if (htext2 != NULL) htext = htext2;
211 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
212 goto error;
214 ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext);
216 CloseClipboard ();
218 if (ok) goto done;
220 error:
222 ok = FALSE;
223 if (htext) GlobalFree (htext);
225 done:
226 UNBLOCK_INPUT;
228 return (ok ? string : Qnil);
231 DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, Sw32_get_clipboard_data, 0, 1, 0,
232 "This gets the clipboard data in text format.")
233 (frame)
234 Lisp_Object frame;
236 HANDLE htext;
237 Lisp_Object ret = Qnil;
239 if (!NILP (frame))
240 CHECK_LIVE_FRAME (frame, 0);
242 BLOCK_INPUT;
244 if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
245 goto done;
247 if ((htext = GetClipboardData (CF_TEXT)) == NULL)
248 goto closeclip;
251 unsigned char *src;
252 unsigned char *dst;
253 int nbytes;
254 int truelen;
255 int require_decoding = 0;
257 if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
258 goto closeclip;
260 nbytes = strlen (src);
262 if (
263 #if 1
265 #else
266 ! NILP (buffer_defaults.enable_multibyte_characters)
267 #endif
270 /* If the clipboard data contains any non-ascii code, we
271 need to decode it. */
272 int i;
274 for (i = 0; i < nbytes; i++)
276 if (src[i] >= 0x80)
278 require_decoding = 1;
279 break;
284 if (require_decoding)
286 int bufsize;
287 unsigned char *buf;
288 struct coding_system coding;
290 if (NILP (Vnext_selection_coding_system))
291 Vnext_selection_coding_system = Vselection_coding_system;
292 setup_coding_system
293 (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
294 Vnext_selection_coding_system = Qnil;
295 coding.mode |= CODING_MODE_LAST_BLOCK;
296 bufsize = decoding_buffer_size (&coding, nbytes);
297 buf = (unsigned char *) xmalloc (bufsize);
298 decode_coding (&coding, src, buf, nbytes, bufsize);
299 Vlast_coding_system_used = coding.symbol;
300 truelen = (coding.fake_multibyte
301 ? multibyte_chars_in_text (buf, coding.produced)
302 : coding.produced_char);
303 ret = make_string_from_bytes ((char *) buf, truelen, coding.produced);
304 xfree (buf);
306 else
308 /* Need to know final size after CR chars are removed because we
309 can't change the string size manually, and doing an extra
310 copy is silly. Note that we only remove CR when it appears
311 as part of CRLF. */
313 truelen = nbytes;
314 dst = src;
315 /* avoid using strchr because it recomputes the length everytime */
316 while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL)
318 if (dst[1] == '\n') /* safe because of trailing '\0' */
319 truelen--;
320 dst++;
323 ret = make_uninit_string (truelen);
325 /* Convert CRLF line endings (the standard CF_TEXT clipboard
326 format) to LF endings as used internally by Emacs. */
328 dst = XSTRING (ret)->data;
329 while (1)
331 unsigned char *next;
332 /* copy next line or remaining bytes excluding '\0' */
333 next = _memccpy (dst, src, '\r', nbytes);
334 if (next)
336 /* copied one line ending with '\r' */
337 int copied = next - dst;
338 nbytes -= copied;
339 dst += copied;
340 src += copied;
341 if (*src == '\n')
342 dst--; /* overwrite '\r' with '\n' */
344 else
345 /* copied remaining partial line -> now finished */
346 break;
349 Vlast_coding_system_used = Qraw_text;
352 GlobalUnlock (htext);
355 closeclip:
356 CloseClipboard ();
358 done:
359 UNBLOCK_INPUT;
361 return (ret);
364 /* Support checking for a clipboard selection. */
366 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
367 0, 1, 0,
368 "Whether there is an owner for the given X Selection.\n\
369 The arg should be the name of the selection in question, typically one of\n\
370 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
371 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
372 For convenience, the symbol nil is the same as `PRIMARY',\n\
373 and t is the same as `SECONDARY'.")
374 (selection)
375 Lisp_Object selection;
377 CHECK_SYMBOL (selection, 0);
379 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
380 if the clipboard currently has valid text format contents. */
382 if (EQ (selection, QCLIPBOARD))
384 Lisp_Object val = Qnil;
386 if (OpenClipboard (NULL))
388 int format = 0;
389 while (format = EnumClipboardFormats (format))
390 if (format == CF_TEXT)
392 val = Qt;
393 break;
395 CloseClipboard ();
397 return val;
399 return Qnil;
402 void
403 syms_of_w32select ()
405 #if 0
406 defsubr (&Sw32_open_clipboard);
407 defsubr (&Sw32_empty_clipboard);
408 defsubr (&Sw32_close_clipboard);
409 #endif
410 defsubr (&Sw32_set_clipboard_data);
411 defsubr (&Sw32_get_clipboard_data);
412 defsubr (&Sx_selection_exists_p);
414 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
415 "Coding system for communicating with other X clients.\n\
416 When sending or receiving text via cut_buffer, selection, and clipboard,\n\
417 the text is encoded or decoded by this coding system.\n\
418 A default value is `compound-text'");
419 Vselection_coding_system=intern ("iso-latin-1-dos");
421 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
422 "Coding system for the next communication with other X clients.\n\
423 Usually, `selection-coding-system' is used for communicating with\n\
424 other X clients. But, if this variable is set, it is used for the\n\
425 next communication only. After the communication, this variable is\n\
426 set to nil.");
427 Vnext_selection_coding_system = Qnil;
429 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);