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