Source

xemacs-21.4 / src / select-msw.c

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
/* mswindows selection processing for XEmacs
   Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.

This file is part of XEmacs.

XEmacs is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

XEmacs is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with XEmacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

/* Synched up with: Not synched with FSF. */

/* Authorship:

   Written by Kevin Gallo for FSF Emacs.
   Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
   Hacked by Alastair Houghton, July 2000 for enhanced clipboard support.
*/

#include <config.h>
#include "lisp.h"
#include "frame.h"
#include "select.h"
#include "opaque.h"
#include "file-coding.h"
#include "buffer.h"

#include "console-msw.h"

/* A list of handles that we must release. Not accessible from Lisp. */
static Lisp_Object Vhandle_alist;

/* Test if this is an X symbol that we understand */
static int
x_sym_p (Lisp_Object value)
{
  if (NILP (value) || INTP (value))
    return 0;

  /* Check for some of the X symbols */
  if (EQ (value, QSTRING))		return 1;
  if (EQ (value, QTEXT))		return 1;
  if (EQ (value, QCOMPOUND_TEXT))	return 1;

  return 0;
}

/* This converts a Lisp symbol to an MS-Windows clipboard format.
   We have symbols for all predefined clipboard formats, but that
   doesn't mean we support them all ;-)
   The name of this function is actually a lie - it also knows about
   integers and strings... */
static UINT
symbol_to_ms_cf (Lisp_Object value)
{
  /* If it's NIL, we're in trouble. */
  if (NILP (value))			return 0;

  /* If it's an integer, assume it's a format ID */
  if (INTP (value))			return (UINT) (XINT (value));

  /* If it's a string, register the format(!) */
  if (STRINGP (value))
    return RegisterClipboardFormat (XSTRING_DATA (value));

  /* Check for Windows clipboard format symbols */
  if (EQ (value, QCF_TEXT))		return CF_TEXT;
  if (EQ (value, QCF_BITMAP))		return CF_BITMAP;
  if (EQ (value, QCF_METAFILEPICT))	return CF_METAFILEPICT;
  if (EQ (value, QCF_SYLK))		return CF_SYLK;
  if (EQ (value, QCF_DIF))		return CF_DIF;
  if (EQ (value, QCF_TIFF))		return CF_TIFF;
  if (EQ (value, QCF_OEMTEXT))		return CF_OEMTEXT;
  if (EQ (value, QCF_DIB))		return CF_DIB;
#ifdef CF_DIBV5
  if (EQ (value, QCF_DIBV5))		return CF_DIBV5;
#endif
  if (EQ (value, QCF_PALETTE))		return CF_PALETTE;
  if (EQ (value, QCF_PENDATA))		return CF_PENDATA;
  if (EQ (value, QCF_RIFF))		return CF_RIFF;
  if (EQ (value, QCF_WAVE))		return CF_WAVE;
  if (EQ (value, QCF_UNICODETEXT))	return CF_UNICODETEXT;
  if (EQ (value, QCF_ENHMETAFILE))	return CF_ENHMETAFILE;
  if (EQ (value, QCF_HDROP))		return CF_HDROP;
  if (EQ (value, QCF_LOCALE))		return CF_LOCALE;
  if (EQ (value, QCF_OWNERDISPLAY))	return CF_OWNERDISPLAY;
  if (EQ (value, QCF_DSPTEXT))		return CF_DSPTEXT;
  if (EQ (value, QCF_DSPBITMAP))	return CF_DSPBITMAP;
  if (EQ (value, QCF_DSPMETAFILEPICT))	return CF_DSPMETAFILEPICT;
  if (EQ (value, QCF_DSPENHMETAFILE))	return CF_DSPENHMETAFILE;

  return 0;
}

/* This converts an MS-Windows clipboard format to its corresponding
   Lisp symbol, or a Lisp integer otherwise. */
static Lisp_Object
ms_cf_to_symbol (UINT format)
{
  switch (format)
    {
    case CF_TEXT:		return QCF_TEXT;
    case CF_BITMAP:		return QCF_BITMAP;
    case CF_METAFILEPICT:	return QCF_METAFILEPICT;
    case CF_SYLK:		return QCF_SYLK;
    case CF_DIF:		return QCF_DIF;
    case CF_TIFF:		return QCF_TIFF;
    case CF_OEMTEXT:		return QCF_OEMTEXT;
    case CF_DIB:		return QCF_DIB;
#ifdef CF_DIBV5
    case CF_DIBV5:		return QCF_DIBV5;
#endif
    case CF_PALETTE:		return QCF_PALETTE;
    case CF_PENDATA:		return QCF_PENDATA;
    case CF_RIFF:		return QCF_RIFF;
    case CF_WAVE:		return QCF_WAVE;
    case CF_UNICODETEXT:	return QCF_UNICODETEXT;
    case CF_ENHMETAFILE:	return QCF_ENHMETAFILE;
    case CF_HDROP:		return QCF_HDROP;
    case CF_LOCALE:		return QCF_LOCALE;
    case CF_OWNERDISPLAY:	return QCF_OWNERDISPLAY;
    case CF_DSPTEXT:		return QCF_DSPTEXT;
    case CF_DSPBITMAP:		return QCF_DSPBITMAP;
    case CF_DSPMETAFILEPICT:	return QCF_DSPMETAFILEPICT;
    case CF_DSPENHMETAFILE:	return QCF_DSPENHMETAFILE;
    default:			return make_int ((int) format);
    }
}

/* Test if the specified clipboard format is auto-released by the OS. If
   not, we must remember the handle on Vhandle_alist, and free it if
   the clipboard is emptied or if we set data with the same format. */
static int
cf_is_autofreed (UINT format)
{
  switch (format)
    {
      /* This list comes from the SDK documentation */
    case CF_DSPENHMETAFILE:
    case CF_DSPMETAFILEPICT:
    case CF_ENHMETAFILE:
    case CF_METAFILEPICT:
    case CF_BITMAP:
    case CF_DSPBITMAP:
    case CF_PALETTE:
    case CF_DIB:
#ifdef CF_DIBV5
    case CF_DIBV5:
#endif
    case CF_DSPTEXT:
    case CF_OEMTEXT:
    case CF_TEXT:
    case CF_UNICODETEXT:
      return TRUE;

    default:
      return FALSE;
    }
}

/* Do protocol to assert ourself as a selection owner.

   Under mswindows, we:

   * Only set the clipboard if (eq selection-name 'CLIPBOARD)

   * Check if an X atom name has been passed. If so, convert to CF_TEXT
     (or CF_UNICODETEXT) remembering to perform LF -> CR-LF conversion.

   * Otherwise assume the data is formatted appropriately for the data type
     that was passed.

   Then set the clipboard as necessary.
*/
static Lisp_Object
mswindows_own_selection (Lisp_Object selection_name,
			 Lisp_Object selection_value,
			 Lisp_Object how_to_add,
			 Lisp_Object selection_type)
{
  HGLOBAL 	hValue = NULL;
  UINT		cfType;
  int		is_X_type = FALSE;
  Lisp_Object	cfObject;
  Lisp_Object	data = Qnil;
  int		size;
  void		*src, *dst;
  struct frame  *f = NULL;

  /* Only continue if we're trying to set the clipboard - mswindows doesn't
     use the same selection model as X */
  if (!EQ (selection_name, QCLIPBOARD))
    return Qnil;

  /* If this is one of the X-style atom name symbols, or NIL, convert it
     as appropriate */
  if (NILP (selection_type) || x_sym_p (selection_type))
    {
      /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
      cfType = CF_TEXT;
      cfObject = QCF_TEXT;
      is_X_type = TRUE;
    }
  else
    {
      cfType = symbol_to_ms_cf (selection_type);

      /* Only continue if we can figure out a clipboard type */
      if (!cfType)
	return Qnil;

      cfObject = selection_type;
    }

  /* Convert things appropriately */
  data = select_convert_out (selection_name,
			     cfObject,
			     selection_value);

  if (NILP (data))
    return Qnil;

  if (CONSP (data))
    {
      if (!EQ (XCAR (data), cfObject))
	cfType = symbol_to_ms_cf (XCAR (data));

      if (!cfType)
	return Qnil;

      data = XCDR (data);
    }

  /* We support opaque or string values, but we only mention string
     values for now... */
  if (!OPAQUEP (data)
      && !STRINGP (data))
    return Qnil;

  /* Compute the data length */
  if (OPAQUEP (data))
    size = XOPAQUE_SIZE (data);
  else
    size = XSTRING_LENGTH (data) + 1;

  /* Find the frame */
  f = selected_frame ();

  /* Open the clipboard */
  if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
    return Qnil;

  /* Allocate memory */
  hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);

  if (!hValue)
    {
      CloseClipboard ();

      return Qnil;
    }

  /* Copy the data */
  if (OPAQUEP (data))
    src = XOPAQUE_DATA (data);
  else
    src = XSTRING_DATA (data);

  dst = GlobalLock (hValue);

  if (!dst)
    {
      GlobalFree (hValue);
      CloseClipboard ();

      return Qnil;
    }

  memcpy (dst, src, size);

  GlobalUnlock (hValue);

  /* Empty the clipboard if we're replacing everything */
  if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
    {
      if (!EmptyClipboard ())
	{
	  CloseClipboard ();
	  GlobalFree (hValue);

	  return Qnil;
	}
    }

  /* Append is currently handled in select.el; perhaps this should change,
     but it only really makes sense for ordinary text in any case... */

  SetClipboardData (cfType, hValue);

  if (!cf_is_autofreed (cfType))
    {
      Lisp_Object alist_elt = Qnil, rest;
      Lisp_Object cfType_int = make_int (cfType);

      /* First check if there's an element in the alist for this type
	 already. */
      alist_elt = assq_no_quit (cfType_int, Vhandle_alist);

      /* Add an element to the alist */
      Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)),
			     Vhandle_alist);

      if (!NILP (alist_elt))
	{
	  /* Free the original handle */
	  GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));

	  /* Remove the original one (adding first makes life easier, because
	     we don't have to special case this being the first element)      */
	  for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest))
	    if (EQ (cfType_int, Fcar (XCDR (rest))))
	      {
		XCDR (rest) = Fcdr (XCDR (rest));
		break;
	      }
	}
    }

  CloseClipboard ();

  /* #### Should really return a time, though this is because of the
     X model (by the looks of things) */
  return Qnil;
}

static Lisp_Object
mswindows_available_selection_types (Lisp_Object selection_name)
{
  Lisp_Object	types = Qnil;
  UINT		format = 0;
  struct frame  *f = NULL;

  if (!EQ (selection_name, QCLIPBOARD))
    return Qnil;

  /* Find the frame */
  f = selected_frame ();

  /* Open the clipboard */
  if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
    return Qnil;

  /* #### ajh - Should there be an unwind-protect handler around this?
                It could (well it probably won't, but it's always better to
		be safe) run out of memory and leave the clipboard open... */

  while ((format = EnumClipboardFormats (format)))
    types = Fcons (ms_cf_to_symbol (format), types);

  /* Close it */
  CloseClipboard ();

  return types;
}

static Lisp_Object
mswindows_register_selection_data_type (Lisp_Object type_name)
{
  /* Type already checked in select.c */
  const char *name = XSTRING_DATA (type_name);
  UINT	      format;

  format = RegisterClipboardFormat (name);

  if (format)
    return make_int ((int) format);
  else
    return Qnil;
}

static Lisp_Object
mswindows_selection_data_type_name (Lisp_Object type_id)
{
  UINT		format;
  int		numchars;
  char		name_buf[128];

  /* If it's an integer, convert to a symbol if appropriate */
  if (INTP (type_id))
    type_id = ms_cf_to_symbol (XINT (type_id));

  /* If this is a symbol, return it */
  if (SYMBOLP (type_id))
    return type_id;

  /* Find the format code */
  format = symbol_to_ms_cf (type_id);

  if (!format)
    return Qnil;

  /* Microsoft, stupid Microsoft */
  numchars = GetClipboardFormatName (format, name_buf, 128);

  if (numchars)
    {
      Lisp_Object name;

      /* Do this properly - though we could support UNICODE (UCS-2) if
         MULE could hack it. */
      name = make_ext_string (name_buf, numchars,
			      Fget_coding_system (Qraw_text));

      return name;
    }

  return Qnil;
}

static Lisp_Object
mswindows_get_foreign_selection (Lisp_Object selection_symbol,
				 Lisp_Object target_type)
{
  HGLOBAL	hValue = NULL;
  UINT		cfType;
  Lisp_Object	cfObject = Qnil, ret = Qnil, value = Qnil;
  int		is_X_type = FALSE;
  int		size;
  void		*data;
  struct frame  *f = NULL;
  struct gcpro	gcpro1;

  /* Only continue if we're trying to read the clipboard - mswindows doesn't
     use the same selection model as X */
  if (!EQ (selection_symbol, QCLIPBOARD))
    return Qnil;

  /* If this is one of the X-style atom name symbols, or NIL, convert it
     as appropriate */
  if (NILP (target_type) || x_sym_p (target_type))
    {
      /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
      cfType = CF_TEXT;
      cfObject = QCF_TEXT;
      is_X_type = TRUE;
    }
  else
    {
      cfType = symbol_to_ms_cf (target_type);

      /* Only continue if we can figure out a clipboard type */
      if (!cfType)
	return Qnil;

      cfObject = ms_cf_to_symbol (cfType);
    }

  /* Find the frame */
  f = selected_frame ();

  /* Open the clipboard */
  if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
    return Qnil;

  /* Read the clipboard */
  hValue = GetClipboardData (cfType);

  if (!hValue)
    {
      CloseClipboard ();

      return Qnil;
    }

  /* Find the data */
  size = GlobalSize (hValue);
  data = GlobalLock (hValue);

  if (!data)
    {
      CloseClipboard ();

      return Qnil;
    }

  /* Place it in a Lisp string */
  TO_INTERNAL_FORMAT (DATA, (data, size),
		      LISP_STRING, ret,
		      Qbinary);

  GlobalUnlock (data);
  CloseClipboard ();

  GCPRO1 (ret);

  /* Convert this to the appropriate type. If we can't find anything,
     then we return a cons of the form (DATA-TYPE . STRING), where the
     string contains the raw binary data. */
  value = select_convert_in (selection_symbol,
			     cfObject,
			     ret);

  UNGCPRO;

  if (NILP (value))
    return Fcons (cfObject, ret);
  else
    return value;
}

static void
mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
{
  if (EQ (selection, QCLIPBOARD))
    {
      BOOL success = OpenClipboard (NULL);
      if (success)
	{
	  success = EmptyClipboard ();
	  /* Close it regardless of whether empty worked. */
	  if (!CloseClipboard ())
	    success = FALSE;
	}

      /* #### return success ? Qt : Qnil; */
    }
}

void
mswindows_destroy_selection (Lisp_Object selection)
{
  /* Do nothing if this isn't for the clipboard. */
  if (!EQ (selection, QCLIPBOARD))
    return;

  /* Right. We need to delete everything in Vhandle_alist. */
  {
    LIST_LOOP_2 (elt, Vhandle_alist)
      GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (elt)));
  }

  Vhandle_alist = Qnil;
}

static Lisp_Object
mswindows_selection_exists_p (Lisp_Object selection,
			      Lisp_Object selection_type)
{
  /* We used to be picky about the format, but now we support anything. */
  if (EQ (selection, QCLIPBOARD))
    {
      if (NILP (selection_type))
	return CountClipboardFormats () ? Qt : Qnil;
      else
	return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type))
	  ? Qt : Qnil;
    }
  else
    return Qnil;
}


/************************************************************************/
/*                            initialization                            */
/************************************************************************/

void
console_type_create_select_mswindows (void)
{
  CONSOLE_HAS_METHOD (mswindows, own_selection);
  CONSOLE_HAS_METHOD (mswindows, disown_selection);
  CONSOLE_HAS_METHOD (mswindows, selection_exists_p);
  CONSOLE_HAS_METHOD (mswindows, get_foreign_selection);
  CONSOLE_HAS_METHOD (mswindows, available_selection_types);
  CONSOLE_HAS_METHOD (mswindows, register_selection_data_type);
  CONSOLE_HAS_METHOD (mswindows, selection_data_type_name);
}

void
syms_of_select_mswindows (void)
{
}

void
vars_of_select_mswindows (void)
{
  /* Initialise Vhandle_alist */
  Vhandle_alist = Qnil;
  staticpro (&Vhandle_alist);
}