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, nlines = 0;
 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   dst = src;
 116
 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)
 121     {
 122       nlines++;
 123       dst++;
 124     }
 125
 126   {
 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;
 131
 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)
 136            ? 0
 137            : find_charset_in_str (src, nbytes, charsets, Qnil, 1));
 138
 139     if (!num || (num == 1 && charsets[CHARSET_ASCII]))
 140       {
 141         /* No multibyte character in OBJ.  We need not encode it.  */
 142
 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).  */
 146
 147         truelen = nbytes + nlines;
 148
 149         if ((htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, truelen)) == NULL)
 150           goto error;
 151
 152         if ((dst = (unsigned char *) GlobalLock (htext)) == NULL)
 153           goto error;
 154
 155         /* convert to CRLF line endings expected by clipboard */
 156         while (1)
 157           {
 158             unsigned char *next;
 159             /* copy next line or remaining bytes including '\0' */
 160             next = _memccpy (dst, src, '\n', nbytes);
 161             if (next)
 162               {
 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;
 171               }
 172             else
 173               /* copied remaining partial line -> now finished */
 174               break;
 175           }
 176
 177         GlobalUnlock (htext);
 178
 179         Vlast_coding_system_used = Qraw_text;
 180       }
 181     else
 182       {
 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;
 190
 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;
 208       }
 209   }
 210
 211   if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
 212     goto error;
 213
 214   ok = EmptyClipboard () && SetClipboardData (CF_TEXT, htext);
 215
 216   CloseClipboard ();
 217
 218   if (ok) goto done;
 219
 220  error:
 221
 222   ok = FALSE;
 223   if (htext) GlobalFree (htext);
 224
 225  done:
 226   UNBLOCK_INPUT;
 227
 228   return (ok ? string : Qnil);
 229 }
 230
 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;
 235 {
 236   HANDLE htext;
 237   Lisp_Object ret = Qnil;
 238
 239   if (!NILP (frame))
 240     CHECK_LIVE_FRAME (frame, 0);
 241
 242   BLOCK_INPUT;
 243
 244   if (!OpenClipboard ((!NILP (frame) && FRAME_W32_P (XFRAME (frame))) ? FRAME_W32_WINDOW (XFRAME (frame)) : NULL))
 245     goto done;
 246
 247   if ((htext = GetClipboardData (CF_TEXT)) == NULL)
 248     goto closeclip;
 249
 250   {
 251     unsigned char *src;
 252     unsigned char *dst;
 253     int nbytes;
 254     int truelen;
 255     int require_decoding = 0;
 256
 257     if ((src = (unsigned char *) GlobalLock (htext)) == NULL)
 258       goto closeclip;
 259
 260     nbytes = strlen (src);
 261
 262     if (
 263 #if 1
 264         1
 265 #else
 266         ! NILP (buffer_defaults.enable_multibyte_characters)
 267 #endif
 268         )
 269       {
 270         /* If the clipboard data contains any non-ascii code, we
 271            need to decode it.  */
 272         int i;
 273
 274         for (i = 0; i < nbytes; i++)
 275           {
 276             if (src[i] >= 0x80)
 277               {
 278                 require_decoding = 1;
 279                 break;
 280               }
 281           }
 282       }
 283
 284     if (require_decoding)
 285       {
 286         int bufsize;
 287         unsigned char *buf;
 288         struct coding_system coding;
 289
 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);
 305       }
 306     else
 307       {
 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.  */
 312
 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)
 317           {
 318             if (dst[1] == '\n') /* safe because of trailing '\0' */
 319               truelen--;
 320             dst++;
 321           }
 322
 323         ret = make_uninit_string (truelen);
 324
 325         /* Convert CRLF line endings (the standard CF_TEXT clipboard
 326            format) to LF endings as used internally by Emacs.  */
 327
 328         dst = XSTRING (ret)->data;
 329         while (1)
 330           {
 331             unsigned char *next;
 332             /* copy next line or remaining bytes excluding '\0' */
 333             next = _memccpy (dst, src, '\r', nbytes);
 334             if (next)
 335               {
 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' */
 343               }
 344             else
 345               /* copied remaining partial line -> now finished */
 346               break;
 347           }
 348
 349         Vlast_coding_system_used = Qraw_text;
 350       }
 351
 352     GlobalUnlock (htext);
 353   }
 354
 355  closeclip:
 356   CloseClipboard ();
 357
 358  done:
 359   UNBLOCK_INPUT;
 360
 361   return (ret);
 362 }
 363
 364 /* Support checking for a clipboard selection. */
 365
 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;
 376 {
 377   CHECK_SYMBOL (selection, 0);
 378
 379   /* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
 380      if the clipboard currently has valid text format contents. */
 381
 382   if (EQ (selection, QCLIPBOARD))
 383     {
 384       Lisp_Object val = Qnil;
 385
 386       if (OpenClipboard (NULL))
 387         {
 388           int format = 0;
 389           while (format = EnumClipboardFormats (format))
 390             if (format == CF_TEXT)
 391               {
 392                 val = Qt;
 393                 break;
 394               }
 395           CloseClipboard ();
 396         }
 397       return val;
 398     }
 399   return Qnil;
 400 }
 401
 402 void
 403 syms_of_w32select ()
 404 {
 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);
 413
 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");
 420
 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;
 428
 429   QCLIPBOARD = intern ("CLIPBOARD");    staticpro (&QCLIPBOARD);
 430 }