src/w32select.c

   1 /* Selection processing for Emacs on the Microsoft W32 API.
   2    Copyright (C) 1993, 1994 Free Software Foundation.
   3
   4 This file is part of GNU Emacs.
   5
   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.
  10
  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.
  15
  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.  */
  20
  21 /* Written by Kevin Gallo */
  22
  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"
  32
  33 Lisp_Object QCLIPBOARD;
  34
  35 /* Coding system for communicating with other Windows programs via the
  36    clipboard.  */
  37 static Lisp_Object Vselection_coding_system;
  38
  39 /* Coding system for the next communicating with other X clients.  */
  40 static Lisp_Object Vnext_selection_coding_system;
  41
  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;
  47 {
  48   BOOL ok = FALSE;
  49
  50   if (!NILP (frame))
  51     CHECK_LIVE_FRAME (frame, 0);
  52
  53   BLOCK_INPUT;
  54
  55   ok = OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL);
  56
  57   UNBLOCK_INPUT;
  58
  59   return (ok ? frame : Qnil);
  60 }
  61
  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.")
  64      ()
  65 {
  66   BOOL ok = FALSE;
  67
  68   BLOCK_INPUT;
  69
  70   ok = EmptyClipboard ();
  71
  72   UNBLOCK_INPUT;
  73
  74   return (ok ? Qt : Qnil);
  75 }
  76
  77 DEFUN ("w32-close-clipboard", Fw32_close_clipboard, Sw32_close_clipboard, 0, 0, 0,
  78        "This closes the clipboard.")
  79      ()
  80 {
  81   BOOL ok = FALSE;
  82
  83   BLOCK_INPUT;
  84
  85   ok = CloseClipboard ();
  86
  87   UNBLOCK_INPUT;
  88
  89   return (ok ? Qt : Qnil);
  90 }
  91
  92 #endif
  93
  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;
  98 {
  99   BOOL ok = TRUE;
 100   HANDLE htext;
 101   int nbytes;
 102   int truelen;
 103   unsigned char *src;
 104   unsigned char *dst;
 105
 106   CHECK_STRING (string, 0);
 107
 108   if (!NILP (frame))
 109     CHECK_LIVE_FRAME (frame, 0);
 110
 111   BLOCK_INPUT;
 112
 113   nbytes = STRING_BYTES (XSTRING (string)) + 1;
 114   src = XSTRING (string)->data;
 115
 116   {
 117     /* Since we are now handling multilingual text, we must consider
 118        encoding text for the clipboard.  */
 119     int charsets[MAX_CHARSET + 1];
 120     int num;
 121
 122     bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
 123     num = ((nbytes <= 1 /* Check the possibility of short cut.  */
 124             || !STRING_MULTIBYTE (string)
 125             || nbytes == XSTRING (string)->size)
 126            ? 0
 127            : find_charset_in_str (src, nbytes, charsets, Qnil, 0, 1));
 128
 129     if (!num || (num == 1 && charsets[CHARSET_ASCII]))
 130       {
 131         /* No multibyte character in OBJ.  We need not encode it.  */
 132
 133         /* Need to know final size after CR chars are inserted (the
 134            standard CF_TEXT clipboard format uses CRLF line endings,
 135            while Emacs uses just LF internally).  */
 136
 137         truelen = nbytes;
 138         dst = src;
 139         /* avoid using strchr because it recomputes the length everytime */
 140         while ((dst = memchr (dst, '\n', nbytes - (dst - src))) != NULL)
 141           {
 142             truelen++;
 143             dst++;
 144           }
 145
 146         if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
 147           goto error;
 148
 149         if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
 150           goto error;
 151
 152         /* convert to CRLF line endings expected by clipboard */
 153         while (1)
 154           {
 155             unsigned char *next;
 156             /* copy next line or remaining bytes including '\0' */
 157             next = _memccpy (dst, src, '\n', nbytes);
 158             if (next)
 159               {
 160                 /* copied one line ending with '\n' */
 161                 int copied = next - dst;
 162                 nbytes -= copied;
 163                 src += copied;
 164                 /* insert '\r' before '\n' */
 165                 next[-1] = '\r';
 166                 next[0] = '\n';
 167                 dst = next + 1;
 168               }
 169             else
 170               /* copied remaining partial line -> now finished */
 171               break;
 172           }
 173
 174         GlobalUnlock (htext);
 175
 176         Vlast_coding_system_used = Qraw_text;
 177       }
 178     else
 179       {
 180         /* We must encode contents of OBJ to compound text format.
 181            The format is compatible with what the target `STRING'
 182            expects if OBJ contains only ASCII and Latin-1
 183            characters.  */
 184         int bufsize;
 185         struct coding_system coding;
 186         HANDLE htext2;
 187
 188         if (NILP (Vnext_selection_coding_system))
 189           Vnext_selection_coding_system = Vselection_coding_system;
 190         setup_coding_system
 191           (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
 192         Vnext_selection_coding_system = Qnil;
 193         coding.mode |= CODING_MODE_LAST_BLOCK;
 194         bufsize = encoding_buffer_size (&coding, nbytes);
 195         if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize)) == NULL)
 196           goto error;
 197         if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
 198           goto error;
 199         encode_coding (&coding, src, dst, nbytes, bufsize);
 200         Vlast_coding_system_used = coding.symbol;
 201         GlobalUnlock (htext);
 202         /* Shrink data block to actual size.  */
 203         htext2 = GlobalReAlloc (htext, coding.produced, GMEM_MOVEABLE | GMEM_DDESHARE);
 204         if (htext2 != NULL) htext = htext2;
 205       }
 206   }
 207
 208   if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
 209     goto error;
 210
 211   ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext);
 212
 213   CloseClipboard ();
 214
 215   if (ok) goto done;
 216
 217  error:
 218
 219   ok = FALSE;
 220   if (htext) GlobalFree (htext);
 221
 222  done:
 223   UNBLOCK_INPUT;
 224
 225   return (ok ? string : Qnil);
 226 }
 227
 228 DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, Sw32_get_clipboard_data, 0, 1, 0,
 229        "This gets the clipboard data in text format.")
 230      (frame)
 231      Lisp_Object frame;
 232 {
 233   HANDLE htext;
 234   Lisp_Object ret = Qnil;
 235
 236   if (!NILP (frame))
 237     CHECK_LIVE_FRAME (frame, 0);
 238
 239   BLOCK_INPUT;
 240
 241   if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
 242     goto done;
 243
 244   if ((htext = GetClipboardData (CF_TEXT)) == NULL)
 245     goto closeclip;
 246
 247   {
 248     unsigned char *src;
 249     unsigned char *dst;
 250     int nbytes;
 251     int truelen;
 252     int require_decoding = 0;
 253
 254     if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
 255       goto closeclip;
 256
 257     nbytes = strlen (src);
 258
 259     if (
 260 #if 1
 261         1
 262 #else
 263         ! NILP (buffer_defaults.enable_multibyte_characters)
 264 #endif
 265         )
 266       {
 267         /* If the clipboard data contains any non-ascii code, we
 268            need to decode it.  */
 269         int i;
 270
 271         for (i = 0; i < nbytes; i++)
 272           {
 273             if (src[i] >= 0x80)
 274               {
 275                 require_decoding = 1;
 276                 break;
 277               }
 278           }
 279       }
 280
 281     if (require_decoding)
 282       {
 283         int bufsize;
 284         unsigned char *buf;
 285         struct coding_system coding;
 286
 287         if (NILP (Vnext_selection_coding_system))
 288           Vnext_selection_coding_system = Vselection_coding_system;
 289         setup_coding_system
 290           (Fcheck_coding_system (Vnext_selection_coding_system), &coding);
 291         Vnext_selection_coding_system = Qnil;
 292         coding.mode |= CODING_MODE_LAST_BLOCK;
 293         bufsize = decoding_buffer_size (&coding, nbytes);
 294         buf = (unsigned char *) xmalloc (bufsize);
 295         decode_coding (&coding, src, buf, nbytes, bufsize);
 296         Vlast_coding_system_used = coding.symbol;
 297         truelen = (coding.fake_multibyte
 298                    ? multibyte_chars_in_text (buf, coding.produced)
 299                    : coding.produced_char);
 300         ret = make_string_from_bytes ((char *) buf, truelen, coding.produced);
 301         xfree (buf);
 302       }
 303     else
 304       {
 305         /* Need to know final size after CR chars are removed because we
 306            can't change the string size manually, and doing an extra
 307            copy is silly.  Note that we only remove CR when it appears
 308            as part of CRLF.  */
 309
 310         truelen = nbytes;
 311         dst = src;
 312         /* avoid using strchr because it recomputes the length everytime */
 313         while ((dst = memchr (dst, '\r', nbytes - (dst - src))) != NULL)
 314           {
 315             if (dst[1] == '\n') /* safe because of trailing '\0' */
 316               truelen--;
 317             dst++;
 318           }
 319
 320         ret = make_uninit_string (truelen);
 321
 322         /* Convert CRLF line endings (the standard CF_TEXT clipboard
 323            format) to LF endings as used internally by Emacs.  */
 324
 325         dst = XSTRING (ret)->data;
 326         while (1)
 327           {
 328             unsigned char *next;
 329             /* copy next line or remaining bytes excluding '\0' */
 330             next = _memccpy (dst, src, '\r', nbytes);
 331             if (next)
 332               {
 333                 /* copied one line ending with '\r' */
 334                 int copied = next - dst;
 335                 nbytes -= copied;
 336                 dst += copied;
 337                 src += copied;
 338                 if (*src == '\n')
 339                   dst--;        /* overwrite '\r' with '\n' */
 340               }
 341             else
 342               /* copied remaining partial line -> now finished */
 343               break;
 344           }
 345
 346         Vlast_coding_system_used = Qraw_text;
 347       }
 348
 349     GlobalUnlock (htext);
 350   }
 351
 352  closeclip:
 353   CloseClipboard ();
 354
 355  done:
 356   UNBLOCK_INPUT;
 357
 358   return (ret);
 359 }
 360
 361 /* Support checking for a clipboard selection. */
 362
 363 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
 364   0, 1, 0,
 365   "Whether there is an owner for the given X Selection.\n\
 366 The arg should be the name of the selection in question, typically one of\n\
 367 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
 368 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
 369 For convenience, the symbol nil is the same as `PRIMARY',\n\
 370 and t is the same as `SECONDARY'.")
 371   (selection)
 372      Lisp_Object selection;
 373 {
 374   CHECK_SYMBOL (selection, 0);
 375
 376   /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
 377      if the clipboard currently has valid text format contents. */
 378
 379   if (EQ (selection, QCLIPBOARD))
 380     {
 381       Lisp_Object val = Qnil;
 382
 383       if (OpenClipboard (NULL))
 384         {
 385           int format = 0;
 386           while (format = EnumClipboardFormats (format))
 387             if (format == CF_TEXT)
 388               {
 389                 val = Qt;
 390                 break;
 391               }
 392           CloseClipboard ();
 393         }
 394       return val;
 395     }
 396   return Qnil;
 397 }
 398
 399 void
 400 syms_of_w32select ()
 401 {
 402 #if 0
 403   defsubr (&Sw32_open_clipboard);
 404   defsubr (&Sw32_empty_clipboard);
 405   defsubr (&Sw32_close_clipboard);
 406 #endif
 407   defsubr (&Sw32_set_clipboard_data);
 408   defsubr (&Sw32_get_clipboard_data);
 409   defsubr (&Sx_selection_exists_p);
 410
 411   DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
 412     "Coding system for communicating with other X clients.\n\
 413 When sending or receiving text via cut_buffer, selection, and clipboard,\n\
 414 the text is encoded or decoded by this coding system.\n\
 415 A default value is `compound-text'");
 416   Vselection_coding_system=intern ("iso-latin-1-dos");
 417
 418   DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
 419     "Coding system for the next communication with other X clients.\n\
 420 Usually, `selection-coding-system' is used for communicating with\n\
 421 other X clients.   But, if this variable is set, it is used for the\n\
 422 next communication only.   After the communication, this variable is\n\
 423 set to nil.");
 424   Vnext_selection_coding_system = Qnil;
 425
 426   QCLIPBOARD = intern ("CLIPBOARD");    staticpro (&QCLIPBOARD);
 427 }