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)
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 */
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"
33 Lisp_Object QCLIPBOARD
;
35 /* Coding system for communicating with other Windows programs via the
37 static Lisp_Object Vselection_coding_system
;
40 DEFUN ("w32-open-clipboard", Fw32_open_clipboard
, Sw32_open_clipboard
, 0, 1, 0,
41 "This opens the clipboard with the given frame pointer.")
48 CHECK_LIVE_FRAME (frame
, 0);
52 ok
= OpenClipboard ((!NILP (frame
) && FRAME_W32_P (XFRAME (frame
))) ? FRAME_W32_WINDOW (XFRAME (frame
)) : NULL
);
56 return (ok
? frame
: Qnil
);
59 DEFUN ("w32-empty-clipboard", Fw32_empty_clipboard
, Sw32_empty_clipboard
, 0, 0, 0,
60 "This empties the clipboard and assigns ownership to the window which opened the clipboard.")
67 ok
= EmptyClipboard ();
71 return (ok
? Qt
: Qnil
);
74 DEFUN ("w32-close-clipboard", Fw32_close_clipboard
, Sw32_close_clipboard
, 0, 0, 0,
75 "This closes the clipboard.")
82 ok
= CloseClipboard ();
86 return (ok
? Qt
: Qnil
);
91 DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data
, Sw32_set_clipboard_data
, 1, 2, 0,
92 "This sets the clipboard data to the given text.")
94 Lisp_Object string
, frame
;
103 CHECK_STRING (string
, 0);
106 CHECK_LIVE_FRAME (frame
, 0);
110 nbytes
= STRING_BYTES (XSTRING (string
)) + 1;
111 src
= XSTRING (string
)->data
;
114 /* Since we are now handling multilingual text, we must consider
115 encoding text for the clipboard. */
116 int charsets
[MAX_CHARSET
+ 1];
119 bzero (charsets
, (MAX_CHARSET
+ 1) * sizeof (int));
120 num
= ((nbytes
<= 2 /* Check the possibility of short cut. */
121 || NILP (buffer_defaults
.enable_multibyte_characters
))
123 : find_charset_in_str (src
, nbytes
, charsets
, Qnil
, 1));
125 if (!num
|| (num
== 1 && charsets
[CHARSET_ASCII
]))
127 /* No multibyte character in OBJ. We need not encode it. */
129 /* need to know final size after '\r' chars are inserted (the
130 standard CF_TEXT clipboard format uses CRLF line endings,
131 while Emacs uses just LF internally) */
135 /* avoid using strchr because it recomputes the length everytime */
136 while ((dst
= memchr (dst
, '\n', nbytes
- (dst
- src
))) != NULL
)
142 if ((htext
= GlobalAlloc (GMEM_MOVEABLE
| GMEM_DDESHARE
, truelen
)) == NULL
)
145 if ((dst
= (unsigned char *) GlobalLock (htext
)) == NULL
)
148 /* convert to CRLF line endings expected by clipboard */
152 /* copy next line or remaining bytes including '\0' */
153 next
= _memccpy (dst
, src
, '\n', nbytes
);
156 /* copied one line ending with '\n' */
157 int copied
= next
- dst
;
160 /* insert '\r' before '\n' */
166 /* copied remaining partial line -> now finished */
170 GlobalUnlock (htext
);
172 Vlast_coding_system_used
= Qraw_text
;
176 /* We must encode contents of OBJ to compound text format.
177 The format is compatible with what the target `STRING'
178 expects if OBJ contains only ASCII and Latin-1
181 struct coding_system coding
;
185 (Fcheck_coding_system (Vselection_coding_system
), &coding
);
186 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
187 bufsize
= encoding_buffer_size (&coding
, nbytes
);
188 if ((htext
= GlobalAlloc (GMEM_MOVEABLE
| GMEM_DDESHARE
, bufsize
)) == NULL
)
190 if ((dst
= (unsigned char *) GlobalLock (htext
)) == NULL
)
192 encode_coding (&coding
, src
, dst
, nbytes
, bufsize
);
193 Vlast_coding_system_used
= coding
.symbol
;
194 GlobalUnlock (htext
);
195 /* Shrink data block to actual size. */
196 htext2
= GlobalReAlloc (htext
, coding
.produced
, GMEM_MOVEABLE
| GMEM_DDESHARE
);
197 if (htext2
!= NULL
) htext
= htext2
;
201 if (!OpenClipboard ((!NILP (frame
) && FRAME_W32_P (XFRAME (frame
))) ? FRAME_W32_WINDOW (XFRAME (frame
)) : NULL
))
204 ok
= EmptyClipboard () && SetClipboardData (CF_TEXT
, htext
);
213 if (htext
) GlobalFree (htext
);
218 return (ok
? string
: Qnil
);
221 DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data
, Sw32_get_clipboard_data
, 0, 1, 0,
222 "This gets the clipboard data in text format.")
227 Lisp_Object ret
= Qnil
;
230 CHECK_LIVE_FRAME (frame
, 0);
234 if (!OpenClipboard ((!NILP (frame
) && FRAME_W32_P (XFRAME (frame
))) ? FRAME_W32_WINDOW (XFRAME (frame
)) : NULL
))
237 if ((htext
= GetClipboardData (CF_TEXT
)) == NULL
)
246 if ((src
= (unsigned char *) GlobalLock (htext
)) == NULL
)
249 nbytes
= strlen (src
);
251 if (! NILP (buffer_defaults
.enable_multibyte_characters
))
255 struct coding_system coding
;
258 (Fcheck_coding_system(Vselection_coding_system
), &coding
);
259 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
260 bufsize
= decoding_buffer_size (&coding
, nbytes
);
261 buf
= (unsigned char *) xmalloc (bufsize
);
262 decode_coding (&coding
, src
, buf
, nbytes
, bufsize
);
263 Vlast_coding_system_used
= coding
.symbol
;
264 truelen
= (coding
.fake_multibyte
265 ? multibyte_chars_in_text (buf
, coding
.produced
)
266 : coding
.produced_char
);
267 ret
= make_string_from_bytes ((char *) buf
, truelen
, coding
.produced
);
272 /* need to know final size after '\r' chars are removed because
273 we can't change the string size manually, and doing an extra
278 /* avoid using strchr because it recomputes the length everytime */
279 while ((dst
= memchr (dst
, '\r', nbytes
- (dst
- src
))) != NULL
)
285 ret
= make_uninit_string (truelen
);
287 /* convert CRLF line endings (the standard CF_TEXT clipboard
288 format) to LF endings as used internally by Emacs */
290 dst
= XSTRING (ret
)->data
;
294 /* copy next line or remaining bytes excluding '\0' */
295 next
= _memccpy (dst
, src
, '\r', nbytes
);
298 /* copied one line ending with '\r' */
299 int copied
= next
- dst
;
301 dst
+= copied
- 1; /* overwrite '\r' */
305 /* copied remaining partial line -> now finished */
309 Vlast_coding_system_used
= Qraw_text
;
312 GlobalUnlock (htext
);
324 /* Support checking for a clipboard selection. */
326 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
328 "Whether there is an owner for the given X Selection.\n\
329 The arg should be the name of the selection in question, typically one of\n\
330 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
331 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
332 For convenience, the symbol nil is the same as `PRIMARY',\n\
333 and t is the same as `SECONDARY'.")
335 Lisp_Object selection
;
337 CHECK_SYMBOL (selection
, 0);
339 /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
340 if the clipboard currently has valid text format contents. */
342 if (EQ (selection
, QCLIPBOARD
))
344 Lisp_Object val
= Qnil
;
346 if (OpenClipboard (NULL
))
349 while (format
= EnumClipboardFormats (format
))
350 if (format
== CF_TEXT
)
366 defsubr (&Sw32_open_clipboard
);
367 defsubr (&Sw32_empty_clipboard
);
368 defsubr (&Sw32_close_clipboard
);
370 defsubr (&Sw32_set_clipboard_data
);
371 defsubr (&Sw32_get_clipboard_data
);
372 defsubr (&Sx_selection_exists_p
);
374 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
375 "Coding system for communicating with other X clients.\n\
376 When sending or receiving text via cut_buffer, selection, and clipboard,\n\
377 the text is encoded or decoded by this coding system.\n\
378 A default value is `compound-text'");
379 Vselection_coding_system
=intern ("iso-latin-1-dos");
381 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);