annotate src/select-msw.c @ 776:79940b592197

[xemacs-hg @ 2002-03-15 07:43:14 by ben] .cvsignore: ignore .tmp files that are getting auto-created by VC. Makefile.in.in: Use -no-packages to avoid problems with package files shadowing core files (e.g. unicode.el in mule-ucs). alloc.c, emacs.c, lisp.h: add new -no-packages. make sure list of args for sorting is actually correct. clean up arg parsing code. xemacs.mak: Use -no-packages to avoid problems with package files shadowing core files (e.g. unicode.el in mule-ucs). Makefile: Use -no-packages to avoid problems with package files shadowing core files (e.g. unicode.el in mule-ucs). mule\chinese.el, mule\japan-util.el: fix warnings. behavior-defs.el: fix errors with require. bytecomp-runtime.el: add new funs {when,and}-{f}boundp, clean up docs. cus-edit.el: pretty-print values. dump-paths.el, find-paths.el, startup.el, setup-paths.el: fix problems/inconsistencies parsing options. support new -no-packages option. merge code duplication in dump-paths and startup. lisp-mode.el: indent macrolet and labels correctly. update comments about lisp-indent-function. flet already handled in cl. apropos.el, auto-save.el, buff-menu.el, cl-extra.el, dragdrop.el, faces.el, files.el, fill.el, font-lock.el, font.el, gtk-faces.el, gui.el, help.el, hyper-apropos.el, info.el, isearch-mode.el, keymap.el, lisp-mnt.el, mouse.el, package-admin.el, package-get.el, printer.el, process.el, resize-minibuffer.el, simple.el, toolbar-items.el, wid-edit.el, win32-native.el: fix warnings. very-early-lisp.el: update docs. mule\chinese.el, mule\japan-util.el: fix warnings. mule\chinese.el, mule\japan-util.el: fix warnings. behavior-defs.el: fix errors with require. bytecomp-runtime.el: add new funs {when,and}-{f}boundp, clean up docs. cus-edit.el: pretty-print values. dump-paths.el, find-paths.el, startup.el, setup-paths.el: fix problems/inconsistencies parsing options. support new -no-packages option. merge code duplication in dump-paths and startup. lisp-mode.el: indent macrolet and labels correctly. update comments about lisp-indent-function. flet already handled in cl. apropos.el, auto-save.el, buff-menu.el, cl-extra.el, dragdrop.el, faces.el, files.el, fill.el, font-lock.el, font.el, gtk-faces.el, gui.el, help.el, hyper-apropos.el, info.el, isearch-mode.el, keymap.el, lisp-mnt.el, mouse.el, package-admin.el, package-get.el, printer.el, process.el, resize-minibuffer.el, simple.el, toolbar-items.el, wid-edit.el, win32-native.el: fix warnings. very-early-lisp.el: update docs. mule\chinese.el, mule\japan-util.el: fix warnings. Makefile.in.in: Use -no-packages to avoid problems with package files shadowing core files (e.g. unicode.el in mule-ucs). Makefile.in.in: Use -no-packages to avoid problems with package files shadowing core files (e.g. unicode.el in mule-ucs).
author ben
date Fri, 15 Mar 2002 07:43:43 +0000
parents 943eaba38521
children a5954632b187
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* mswindows selection processing for XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
3 Copyright (C) 2000, 2001 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not synched with FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
24 /* This file Mule-ized 7-00?? Needs some Unicode review. --ben */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
25
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 /* Authorship:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 Written by Kevin Gallo for FSF Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
30 Rewritten April 2000 by Ben Wing -- support device methods, Mule-ize.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
31 Hacked by Alastair Houghton, July 2000 for enhanced clipboard support.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
32 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "lisp.h"
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
36 #include "buffer.h"
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
37 #include "frame.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include "select.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
39 #include "opaque.h"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
40 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "console-msw.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
44 static int in_own_selection;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
45
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
46 /* A list of handles that we must release. Not accessible from Lisp. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
47 static Lisp_Object Vhandle_alist;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
48
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
49 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
50 mswindows_handle_destroyclipboard (void)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
51 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
52 /* We also receive a destroy message when we call EmptyClipboard() and
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
53 we already own it. In this case we don't want to call
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
54 handle_selection_clear() because it will remove what we're trying
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
55 to add! */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
56 if (!in_own_selection)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
57 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
58 /* We own the clipboard and someone else wants it. Delete our
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
59 cached copy of the clipboard contents so we'll ask for it from
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
60 Windows again when someone does a paste, and destroy any memory
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
61 objects we hold on the clipboard that are not in the list of types
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
62 that Windows will delete itself. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
63 mswindows_destroy_selection (QCLIPBOARD);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
64 handle_selection_clear (QCLIPBOARD);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
65 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
66 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
67
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
68 static int
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
69 mswindows_empty_clipboard (void)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
70 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
71 int retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
72
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
73 in_own_selection = 1;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
74 retval = EmptyClipboard ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
75 in_own_selection = 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
76 return retval;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
77 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
78
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
79 /* Test if this is an X symbol that we understand */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
80 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
81 x_sym_p (Lisp_Object value)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
82 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
83 if (NILP (value) || INTP (value))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
84 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
85
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
86 /* Check for some of the X symbols */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
87 if (EQ (value, QSTRING)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
88 if (EQ (value, QTEXT)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
89 if (EQ (value, QCOMPOUND_TEXT)) return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
90
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
91 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
92 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
93
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
94 /* This converts a Lisp symbol to an MS-Windows clipboard format.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
95 We have symbols for all predefined clipboard formats, but that
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
96 doesn't mean we support them all ;-)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
97 The name of this function is actually a lie - it also knows about
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
98 integers and strings... */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
99 static UINT
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
100 symbol_to_ms_cf (Lisp_Object value)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
102 /* If it's NIL, we're in trouble. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
103 if (NILP (value)) return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
104
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
105 /* If it's an integer, assume it's a format ID */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
106 if (INTP (value)) return (UINT) (XINT (value));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
107
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
108 /* If it's a string, register the format(!) */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
109 if (STRINGP (value))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
110 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
111 Extbyte *valext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
112 LISP_STRING_TO_TSTR (value, valext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
113 return qxeRegisterClipboardFormat (valext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
114 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
115
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
116 /* Check for Windows clipboard format symbols */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
117 if (EQ (value, QCF_TEXT)) return CF_TEXT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
118 if (EQ (value, QCF_BITMAP)) return CF_BITMAP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
119 if (EQ (value, QCF_METAFILEPICT)) return CF_METAFILEPICT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
120 if (EQ (value, QCF_SYLK)) return CF_SYLK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
121 if (EQ (value, QCF_DIF)) return CF_DIF;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
122 if (EQ (value, QCF_TIFF)) return CF_TIFF;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
123 if (EQ (value, QCF_OEMTEXT)) return CF_OEMTEXT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
124 if (EQ (value, QCF_DIB)) return CF_DIB;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
125 #ifdef CF_DIBV5
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
126 if (EQ (value, QCF_DIBV5)) return CF_DIBV5;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
127 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
128 if (EQ (value, QCF_PALETTE)) return CF_PALETTE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
129 if (EQ (value, QCF_PENDATA)) return CF_PENDATA;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
130 if (EQ (value, QCF_RIFF)) return CF_RIFF;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
131 if (EQ (value, QCF_WAVE)) return CF_WAVE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
132 if (EQ (value, QCF_UNICODETEXT)) return CF_UNICODETEXT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
133 if (EQ (value, QCF_ENHMETAFILE)) return CF_ENHMETAFILE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
134 if (EQ (value, QCF_HDROP)) return CF_HDROP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
135 if (EQ (value, QCF_LOCALE)) return CF_LOCALE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
136 if (EQ (value, QCF_OWNERDISPLAY)) return CF_OWNERDISPLAY;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
137 if (EQ (value, QCF_DSPTEXT)) return CF_DSPTEXT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
138 if (EQ (value, QCF_DSPBITMAP)) return CF_DSPBITMAP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
139 if (EQ (value, QCF_DSPMETAFILEPICT)) return CF_DSPMETAFILEPICT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
140 if (EQ (value, QCF_DSPENHMETAFILE)) return CF_DSPENHMETAFILE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
141
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
142 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
143 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
144
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
145 /* This converts an MS-Windows clipboard format to its corresponding
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
146 Lisp symbol, or a Lisp integer otherwise. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
147 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
148 ms_cf_to_symbol (UINT format)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
149 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
150 switch (format)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
151 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
152 case CF_TEXT: return QCF_TEXT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
153 case CF_BITMAP: return QCF_BITMAP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
154 case CF_METAFILEPICT: return QCF_METAFILEPICT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
155 case CF_SYLK: return QCF_SYLK;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
156 case CF_DIF: return QCF_DIF;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
157 case CF_TIFF: return QCF_TIFF;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
158 case CF_OEMTEXT: return QCF_OEMTEXT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
159 case CF_DIB: return QCF_DIB;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
160 #ifdef CF_DIBV5
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
161 case CF_DIBV5: return QCF_DIBV5;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
162 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
163 case CF_PALETTE: return QCF_PALETTE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
164 case CF_PENDATA: return QCF_PENDATA;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
165 case CF_RIFF: return QCF_RIFF;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
166 case CF_WAVE: return QCF_WAVE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
167 case CF_UNICODETEXT: return QCF_UNICODETEXT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
168 case CF_ENHMETAFILE: return QCF_ENHMETAFILE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
169 case CF_HDROP: return QCF_HDROP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
170 case CF_LOCALE: return QCF_LOCALE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
171 case CF_OWNERDISPLAY: return QCF_OWNERDISPLAY;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
172 case CF_DSPTEXT: return QCF_DSPTEXT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
173 case CF_DSPBITMAP: return QCF_DSPBITMAP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
174 case CF_DSPMETAFILEPICT: return QCF_DSPMETAFILEPICT;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
175 case CF_DSPENHMETAFILE: return QCF_DSPENHMETAFILE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
176 default: return make_int ((int) format);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
177 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
178 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
180 /* Test if the specified clipboard format is auto-released by the OS. If
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
181 not, we must remember the handle on Vhandle_alist, and free it if
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
182 the clipboard is emptied or if we set data with the same format. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
183 static int
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
184 cf_is_autofreed (UINT format)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
185 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
186 switch (format)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
187 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
188 /* This list comes from the SDK documentation */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
189 case CF_DSPENHMETAFILE:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
190 case CF_DSPMETAFILEPICT:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
191 case CF_ENHMETAFILE:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
192 case CF_METAFILEPICT:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
193 case CF_BITMAP:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
194 case CF_DSPBITMAP:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
195 case CF_PALETTE:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
196 case CF_DIB:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
197 #ifdef CF_DIBV5
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
198 case CF_DIBV5:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
199 #endif
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
200 case CF_DSPTEXT:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
201 case CF_OEMTEXT:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
202 case CF_TEXT:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
203 case CF_UNICODETEXT:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
204 return TRUE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
205
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
206 default:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
207 return FALSE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
208 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
209 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
210
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
211 /* Do protocol to assert ourself as a selection owner.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
212
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
213 Under mswindows, we:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
214
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
215 * Only set the clipboard if (eq selection-name 'CLIPBOARD)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
216
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
217 * Check if an X atom name has been passed. If so, convert to CF_TEXT
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
218 (or CF_UNICODETEXT) remembering to perform LF -> CR-LF conversion.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
219
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
220 * Otherwise assume the data is formatted appropriately for the data type
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
221 that was passed.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
222
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
223 Then set the clipboard as necessary.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
224 */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
225 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
226 mswindows_own_selection (Lisp_Object selection_name,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
227 Lisp_Object selection_value,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
228 Lisp_Object how_to_add,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 442
diff changeset
229 Lisp_Object selection_type,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 442
diff changeset
230 int owned_p /* Not used */)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
231 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
232 HGLOBAL hValue = NULL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
233 UINT cfType;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
234 int is_X_type = FALSE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
235 Lisp_Object cfObject;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
236 Lisp_Object data = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
237 int size;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
238 void *src, *dst;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
239 struct frame *f = NULL;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
241 /* Only continue if we're trying to set the clipboard - mswindows doesn't
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
242 use the same selection model as X */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
243 if (!EQ (selection_name, QCLIPBOARD))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
244 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
245
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
246 /* If this is one of the X-style atom name symbols, or NIL, convert it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
247 as appropriate */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
248 if (NILP (selection_type) || x_sym_p (selection_type))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
249 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
250 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
251 if (XEUNICODE_P)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
252 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
253 cfType = CF_UNICODETEXT;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
254 cfObject = QCF_UNICODETEXT;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
255 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
256 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
257 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
258 cfType = CF_TEXT;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
259 cfObject = QCF_TEXT;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
260 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
261 is_X_type = TRUE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
262 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
263 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
264 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
265 cfType = symbol_to_ms_cf (selection_type);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
266
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
267 /* Only continue if we can figure out a clipboard type */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
268 if (!cfType)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
269 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
270
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
271 cfObject = selection_type;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
272 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
273
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
274 /* Convert things appropriately */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
275 data = select_convert_out (selection_name,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
276 cfObject,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
277 selection_value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
279 if (NILP (data))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
280 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
281
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
282 if (CONSP (data))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
283 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
284 if (!EQ (XCAR (data), cfObject))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
285 cfType = symbol_to_ms_cf (XCAR (data));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
286
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
287 if (!cfType)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
288 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
289
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
290 data = XCDR (data);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
291 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
292
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
293 /* We support opaque or string values, but we only mention string
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
294 values for now...
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
295 #### where do the opaque objects come from? currently they're not
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
296 allowed to be exported to the lisp level! */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
297 if (!OPAQUEP (data)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
298 && !STRINGP (data))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
299 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
300
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
301 /* Find the frame */
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
302 f = selected_frame ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
303
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
304 /* Open the clipboard */
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
305 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
308 /* Obtain the data */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
309 if (OPAQUEP (data))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
310 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
311 src = XOPAQUE_DATA (data);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
312 size = XOPAQUE_SIZE (data);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
313 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
314 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
315 /* we do NOT append a zero byte. we don't know whether we're dealing
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
316 with regular text, unicode text, binary data, etc. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
317 TO_EXTERNAL_FORMAT (LISP_STRING, data, ALLOCA, (src, size),
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
318 Qbinary);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
319
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
320 /* Allocate memory */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
321 hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
322
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
323 if (!hValue)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 CloseClipboard ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
326
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
327 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
328 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
329
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
330 dst = GlobalLock (hValue);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
331
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
332 if (!dst)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
333 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
334 GlobalFree (hValue);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
335 CloseClipboard ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
336
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
339
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
340 memcpy (dst, src, size);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
341
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
342 GlobalUnlock (hValue);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
343
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
344 /* Empty the clipboard if we're replacing everything */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
345 if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
347 if (!mswindows_empty_clipboard ())
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
349 CloseClipboard ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
350 GlobalFree (hValue);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
351
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
352 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
353 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
355
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
356 /* Append is currently handled in select.el; perhaps this should change,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
357 but it only really makes sense for ordinary text in any case... */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
358
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
359 SetClipboardData (cfType, hValue);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
360
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
361 if (!cf_is_autofreed (cfType))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
362 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
363 Lisp_Object alist_elt = Qnil, rest;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
364 Lisp_Object cfType_int = make_int (cfType);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
365
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
366 /* First check if there's an element in the alist for this type
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
367 already. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
368 alist_elt = assq_no_quit (cfType_int, Vhandle_alist);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
369
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
370 /* Add an element to the alist */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
371 Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
372 Vhandle_alist);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
373
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
374 if (!NILP (alist_elt))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
375 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
376 /* Free the original handle */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
377 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
378
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
379 /* Remove the original one (adding first makes life easier,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
380 because we don't have to special case this being the
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
381 first element) */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
382 for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
383 if (EQ (cfType_int, Fcar (XCDR (rest))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
384 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
385 XCDR (rest) = Fcdr (XCDR (rest));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
386 break;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
387 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
388 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
389 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
390
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 CloseClipboard ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
392
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
393 /* #### Should really return a time, though this is because of the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
394 X model (by the looks of things) */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
395 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
399 mswindows_available_selection_types (Lisp_Object selection_name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
400 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
401 Lisp_Object types = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
402 UINT format = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
403 struct frame *f = NULL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
404
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
405 if (!EQ (selection_name, QCLIPBOARD))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
406 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
407
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
408 /* Find the frame */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
409 f = selected_frame ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
410
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
411 /* Open the clipboard */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
412 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
413 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
414
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
415 /* [[ ajh - Should there be an unwind-protect handler around this?
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
416 It could (well it probably won't, but it's always better to
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
417 be safe) run out of memory and leave the clipboard open... ]]
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
418 -- xemacs in general makes no provisions for out-of-memory errors;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
419 we will probably just crash. fixing this is a huge amount of work,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
420 so don't bother protecting in this case. --ben */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
421
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
422 while ((format = EnumClipboardFormats (format)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
423 types = Fcons (ms_cf_to_symbol (format), types);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
424
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
425 /* Close it */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
426 CloseClipboard ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
427
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
428 return types;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
429 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
430
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
431 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
432 mswindows_register_selection_data_type (Lisp_Object type_name)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
434 /* Type already checked in select.c */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
435 Extbyte *nameext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
436 UINT format;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
437
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
438 LISP_STRING_TO_TSTR (type_name, nameext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
439 format = qxeRegisterClipboardFormat (nameext);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
440
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
441 if (format)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
442 return make_int ((int) format);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
443 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
444 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
445 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
446
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
447 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
448 mswindows_selection_data_type_name (Lisp_Object type_id)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
449 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
450 UINT format;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
451 Extbyte *namebuf;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
452 int numchars;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
453
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
454 /* If it's an integer, convert to a symbol if appropriate */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
455 if (INTP (type_id))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
456 type_id = ms_cf_to_symbol (XINT (type_id));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
457
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
458 /* If this is a symbol, return it */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
459 if (SYMBOLP (type_id))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
460 return type_id;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
461
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
462 /* Find the format code */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
463 format = symbol_to_ms_cf (type_id);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
464
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
465 if (!format)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
466 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
467
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
468 /* Microsoft, stupid Microsoft */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
469 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
470 int size, new_size = 128;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
471 do
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
472 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
473 size = new_size;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
474 new_size *= 2;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
475 namebuf = alloca_extbytes (size * XETCHAR_SIZE);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
476 numchars = qxeGetClipboardFormatName (format, namebuf, size);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
477 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
478 while (numchars >= size - 1);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
479 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
480
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
481 if (numchars)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
482 return build_tstr_string (namebuf);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
487 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
488 mswindows_get_foreign_selection (Lisp_Object selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
489 Lisp_Object target_type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
491 HGLOBAL hValue = NULL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
492 UINT cfType;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
493 Lisp_Object cfObject = Qnil, ret = Qnil, value = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
494 int is_X_type = FALSE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
495 int size;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
496 void *data;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
497 struct frame *f = NULL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
498 struct gcpro gcpro1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
499
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
500 /* Only continue if we're trying to read the clipboard - mswindows doesn't
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
501 use the same selection model as X */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
502 if (!EQ (selection_symbol, QCLIPBOARD))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
503 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
505 /* If this is one of the X-style atom name symbols, or NIL, convert it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
506 as appropriate */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
507 if (NILP (target_type) || x_sym_p (target_type))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
508 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
509 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
510 if (XEUNICODE_P)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
511 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
512 cfType = CF_UNICODETEXT;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
513 cfObject = QCF_UNICODETEXT;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
514 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
515 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
516 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
517 cfType = CF_TEXT;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
518 cfObject = QCF_TEXT;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
519 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
520 is_X_type = TRUE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
521 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
522 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
523 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
524 cfType = symbol_to_ms_cf (target_type);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
525
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
526 /* Only continue if we can figure out a clipboard type */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
527 if (!cfType)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
528 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
529
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
530 cfObject = ms_cf_to_symbol (cfType);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
531 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
532
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
533 /* Find the frame */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
534 f = selected_frame ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
535
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
536 /* Open the clipboard */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
537 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
540 /* Read the clipboard */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
541 hValue = GetClipboardData (cfType);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
542
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
543 if (!hValue)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
545 CloseClipboard ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
547 return Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
548 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
550 /* Find the data */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
551 size = GlobalSize (hValue);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
552 data = GlobalLock (hValue);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
554 if (!data)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
555 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
556 CloseClipboard ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
557
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
558 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
561 /* Place it in a Lisp string */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
562 ret = make_ext_string ((Extbyte *) data, size, Qbinary);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
563
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
564 GlobalUnlock (data);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 CloseClipboard ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
567 GCPRO1 (ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
569 /* Convert this to the appropriate type. If we can't find anything,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
570 then we return a cons of the form (DATA-TYPE . STRING), where the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
571 string contains the raw binary data. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
572 value = select_convert_in (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
573 cfObject,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
574 ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
576 UNGCPRO;
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
577
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
578 if (NILP (value))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
579 return Fcons (cfObject, ret);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
580 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
581 return value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 if (EQ (selection, QCLIPBOARD))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
588 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
589 BOOL success = OpenClipboard (NULL);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
590 if (success)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
591 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
592 /* the caller calls handle_selection_clear(). */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
593 success = mswindows_empty_clipboard ();
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
594 /* Close it regardless of whether empty worked. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
595 if (!CloseClipboard ())
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
596 success = FALSE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
597 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
598
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
599 /* #### return success ? Qt : Qnil; */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
600 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
601 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
602
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
603 void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
604 mswindows_destroy_selection (Lisp_Object selection)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
605 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
606 /* Do nothing if this isn't for the clipboard. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
607 if (!EQ (selection, QCLIPBOARD))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
608 return;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
609
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
610 /* Right. We need to delete everything in Vhandle_alist. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
611 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
612 LIST_LOOP_2 (elt, Vhandle_alist)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
613 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (elt)));
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
614 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
615
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
616 Vhandle_alist = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
617 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
618
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
619 static Lisp_Object
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
620 mswindows_selection_exists_p (Lisp_Object selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
621 Lisp_Object selection_type)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
622 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
623 /* We used to be picky about the format, but now we support anything. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
624 if (EQ (selection, QCLIPBOARD))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
625 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
626 if (NILP (selection_type))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
627 return CountClipboardFormats () ? Qt : Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
628 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
629 return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
630 ? Qt : Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
631 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
632 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
633 return Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 console_type_create_select_mswindows (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 CONSOLE_HAS_METHOD (mswindows, own_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 CONSOLE_HAS_METHOD (mswindows, disown_selection);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
646 CONSOLE_HAS_METHOD (mswindows, selection_exists_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 CONSOLE_HAS_METHOD (mswindows, get_foreign_selection);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
648 CONSOLE_HAS_METHOD (mswindows, available_selection_types);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
649 CONSOLE_HAS_METHOD (mswindows, register_selection_data_type);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
650 CONSOLE_HAS_METHOD (mswindows, selection_data_type_name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 syms_of_select_mswindows (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 vars_of_select_mswindows (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
661 /* Initialise Vhandle_alist */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
662 Vhandle_alist = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 430
diff changeset
663 staticpro (&Vhandle_alist);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
665
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
666 void
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
667 init_select_mswindows (void)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
668 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
669 /* Reinitialise Vhandle_alist */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
670 /* #### Why do we need to do this? Somehow I added this. --ben */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
671 Vhandle_alist = Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 593
diff changeset
672 }