Mercurial > hg > xemacs-beta
annotate src/select-msw.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 07 Feb 2011 12:01:24 +0000 |
parents | 3c3c1d139863 |
children | 308d34e9f07d |
rev | line source |
---|---|
428 | 1 /* mswindows selection processing for XEmacs |
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. | |
800 | 3 Copyright (C) 2000, 2001, 2002 Ben Wing. |
428 | 4 |
5 This file is part of XEmacs. | |
6 | |
7 XEmacs is free software; you can redistribute it and/or modify it | |
8 under the terms of the GNU General Public License as published by the | |
9 Free Software Foundation; either version 2, or (at your option) any | |
10 later version. | |
11 | |
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with XEmacs; see the file COPYING. If not, write to | |
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 Boston, MA 02111-1307, USA. */ | |
21 | |
22 /* Synched up with: Not synched with FSF. */ | |
23 | |
771 | 24 /* This file Mule-ized 7-00?? Needs some Unicode review. --ben */ |
25 | |
428 | 26 /* Authorship: |
27 | |
28 Written by Kevin Gallo for FSF Emacs. | |
29 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0. | |
771 | 30 Rewritten April 2000 by Ben Wing -- support device methods, Mule-ize. |
442 | 31 Hacked by Alastair Houghton, July 2000 for enhanced clipboard support. |
32 */ | |
428 | 33 |
34 #include <config.h> | |
35 #include "lisp.h" | |
771 | 36 #include "buffer.h" |
872 | 37 #include "frame-impl.h" |
428 | 38 #include "select.h" |
442 | 39 #include "opaque.h" |
40 #include "file-coding.h" | |
428 | 41 |
872 | 42 #include "console-msw-impl.h" |
428 | 43 |
771 | 44 static int in_own_selection; |
45 | |
442 | 46 /* A list of handles that we must release. Not accessible from Lisp. */ |
47 static Lisp_Object Vhandle_alist; | |
48 | |
771 | 49 void |
50 mswindows_handle_destroyclipboard (void) | |
51 { | |
52 /* We also receive a destroy message when we call EmptyClipboard() and | |
53 we already own it. In this case we don't want to call | |
54 handle_selection_clear() because it will remove what we're trying | |
55 to add! */ | |
56 if (!in_own_selection) | |
57 { | |
58 /* We own the clipboard and someone else wants it. Delete our | |
59 cached copy of the clipboard contents so we'll ask for it from | |
60 Windows again when someone does a paste, and destroy any memory | |
61 objects we hold on the clipboard that are not in the list of types | |
62 that Windows will delete itself. */ | |
63 mswindows_destroy_selection (QCLIPBOARD); | |
64 handle_selection_clear (QCLIPBOARD); | |
65 } | |
66 } | |
67 | |
68 static int | |
69 mswindows_empty_clipboard (void) | |
70 { | |
71 int retval; | |
72 | |
73 in_own_selection = 1; | |
74 retval = EmptyClipboard (); | |
75 in_own_selection = 0; | |
76 return retval; | |
77 } | |
78 | |
442 | 79 /* Test if this is an X symbol that we understand */ |
80 static int | |
81 x_sym_p (Lisp_Object value) | |
82 { | |
83 if (NILP (value) || INTP (value)) | |
84 return 0; | |
85 | |
86 /* Check for some of the X symbols */ | |
87 if (EQ (value, QSTRING)) return 1; | |
88 if (EQ (value, QTEXT)) return 1; | |
89 if (EQ (value, QCOMPOUND_TEXT)) return 1; | |
90 | |
91 return 0; | |
92 } | |
93 | |
94 /* This converts a Lisp symbol to an MS-Windows clipboard format. | |
95 We have symbols for all predefined clipboard formats, but that | |
96 doesn't mean we support them all ;-) | |
97 The name of this function is actually a lie - it also knows about | |
98 integers and strings... */ | |
99 static UINT | |
100 symbol_to_ms_cf (Lisp_Object value) | |
428 | 101 { |
442 | 102 /* If it's NIL, we're in trouble. */ |
103 if (NILP (value)) return 0; | |
104 | |
105 /* If it's an integer, assume it's a format ID */ | |
106 if (INTP (value)) return (UINT) (XINT (value)); | |
107 | |
108 /* If it's a string, register the format(!) */ | |
109 if (STRINGP (value)) | |
771 | 110 { |
111 Extbyte *valext; | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
112 valext = LISP_STRING_TO_TSTR (value); |
771 | 113 return qxeRegisterClipboardFormat (valext); |
114 } | |
442 | 115 |
116 /* Check for Windows clipboard format symbols */ | |
117 if (EQ (value, QCF_TEXT)) return CF_TEXT; | |
118 if (EQ (value, QCF_BITMAP)) return CF_BITMAP; | |
119 if (EQ (value, QCF_METAFILEPICT)) return CF_METAFILEPICT; | |
120 if (EQ (value, QCF_SYLK)) return CF_SYLK; | |
121 if (EQ (value, QCF_DIF)) return CF_DIF; | |
122 if (EQ (value, QCF_TIFF)) return CF_TIFF; | |
123 if (EQ (value, QCF_OEMTEXT)) return CF_OEMTEXT; | |
124 if (EQ (value, QCF_DIB)) return CF_DIB; | |
125 #ifdef CF_DIBV5 | |
126 if (EQ (value, QCF_DIBV5)) return CF_DIBV5; | |
127 #endif | |
128 if (EQ (value, QCF_PALETTE)) return CF_PALETTE; | |
129 if (EQ (value, QCF_PENDATA)) return CF_PENDATA; | |
130 if (EQ (value, QCF_RIFF)) return CF_RIFF; | |
131 if (EQ (value, QCF_WAVE)) return CF_WAVE; | |
132 if (EQ (value, QCF_UNICODETEXT)) return CF_UNICODETEXT; | |
133 if (EQ (value, QCF_ENHMETAFILE)) return CF_ENHMETAFILE; | |
134 if (EQ (value, QCF_HDROP)) return CF_HDROP; | |
135 if (EQ (value, QCF_LOCALE)) return CF_LOCALE; | |
136 if (EQ (value, QCF_OWNERDISPLAY)) return CF_OWNERDISPLAY; | |
137 if (EQ (value, QCF_DSPTEXT)) return CF_DSPTEXT; | |
138 if (EQ (value, QCF_DSPBITMAP)) return CF_DSPBITMAP; | |
139 if (EQ (value, QCF_DSPMETAFILEPICT)) return CF_DSPMETAFILEPICT; | |
140 if (EQ (value, QCF_DSPENHMETAFILE)) return CF_DSPENHMETAFILE; | |
141 | |
142 return 0; | |
143 } | |
144 | |
145 /* This converts an MS-Windows clipboard format to its corresponding | |
146 Lisp symbol, or a Lisp integer otherwise. */ | |
147 static Lisp_Object | |
148 ms_cf_to_symbol (UINT format) | |
149 { | |
150 switch (format) | |
151 { | |
152 case CF_TEXT: return QCF_TEXT; | |
153 case CF_BITMAP: return QCF_BITMAP; | |
154 case CF_METAFILEPICT: return QCF_METAFILEPICT; | |
155 case CF_SYLK: return QCF_SYLK; | |
156 case CF_DIF: return QCF_DIF; | |
157 case CF_TIFF: return QCF_TIFF; | |
158 case CF_OEMTEXT: return QCF_OEMTEXT; | |
159 case CF_DIB: return QCF_DIB; | |
160 #ifdef CF_DIBV5 | |
161 case CF_DIBV5: return QCF_DIBV5; | |
162 #endif | |
163 case CF_PALETTE: return QCF_PALETTE; | |
164 case CF_PENDATA: return QCF_PENDATA; | |
165 case CF_RIFF: return QCF_RIFF; | |
166 case CF_WAVE: return QCF_WAVE; | |
167 case CF_UNICODETEXT: return QCF_UNICODETEXT; | |
168 case CF_ENHMETAFILE: return QCF_ENHMETAFILE; | |
169 case CF_HDROP: return QCF_HDROP; | |
170 case CF_LOCALE: return QCF_LOCALE; | |
171 case CF_OWNERDISPLAY: return QCF_OWNERDISPLAY; | |
172 case CF_DSPTEXT: return QCF_DSPTEXT; | |
173 case CF_DSPBITMAP: return QCF_DSPBITMAP; | |
174 case CF_DSPMETAFILEPICT: return QCF_DSPMETAFILEPICT; | |
175 case CF_DSPENHMETAFILE: return QCF_DSPENHMETAFILE; | |
176 default: return make_int ((int) format); | |
177 } | |
178 } | |
428 | 179 |
442 | 180 /* Test if the specified clipboard format is auto-released by the OS. If |
181 not, we must remember the handle on Vhandle_alist, and free it if | |
182 the clipboard is emptied or if we set data with the same format. */ | |
183 static int | |
184 cf_is_autofreed (UINT format) | |
185 { | |
186 switch (format) | |
187 { | |
188 /* This list comes from the SDK documentation */ | |
189 case CF_DSPENHMETAFILE: | |
190 case CF_DSPMETAFILEPICT: | |
191 case CF_ENHMETAFILE: | |
192 case CF_METAFILEPICT: | |
193 case CF_BITMAP: | |
194 case CF_DSPBITMAP: | |
195 case CF_PALETTE: | |
196 case CF_DIB: | |
197 #ifdef CF_DIBV5 | |
198 case CF_DIBV5: | |
199 #endif | |
200 case CF_DSPTEXT: | |
201 case CF_OEMTEXT: | |
202 case CF_TEXT: | |
203 case CF_UNICODETEXT: | |
204 return TRUE; | |
205 | |
206 default: | |
207 return FALSE; | |
208 } | |
209 } | |
210 | |
211 /* Do protocol to assert ourself as a selection owner. | |
212 | |
213 Under mswindows, we: | |
214 | |
215 * Only set the clipboard if (eq selection-name 'CLIPBOARD) | |
216 | |
217 * Check if an X atom name has been passed. If so, convert to CF_TEXT | |
218 (or CF_UNICODETEXT) remembering to perform LF -> CR-LF conversion. | |
219 | |
220 * Otherwise assume the data is formatted appropriately for the data type | |
221 that was passed. | |
222 | |
223 Then set the clipboard as necessary. | |
224 */ | |
225 static Lisp_Object | |
226 mswindows_own_selection (Lisp_Object selection_name, | |
227 Lisp_Object selection_value, | |
228 Lisp_Object how_to_add, | |
456 | 229 Lisp_Object selection_type, |
2286 | 230 int UNUSED (owned_p)) |
442 | 231 { |
232 HGLOBAL hValue = NULL; | |
233 UINT cfType; | |
234 int is_X_type = FALSE; | |
235 Lisp_Object cfObject; | |
236 Lisp_Object data = Qnil; | |
237 int size; | |
238 void *src, *dst; | |
239 struct frame *f = NULL; | |
428 | 240 |
442 | 241 /* Only continue if we're trying to set the clipboard - mswindows doesn't |
242 use the same selection model as X */ | |
243 if (!EQ (selection_name, QCLIPBOARD)) | |
244 return Qnil; | |
245 | |
246 /* If this is one of the X-style atom name symbols, or NIL, convert it | |
247 as appropriate */ | |
248 if (NILP (selection_type) || x_sym_p (selection_type)) | |
249 { | |
250 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */ | |
771 | 251 if (XEUNICODE_P) |
252 { | |
253 cfType = CF_UNICODETEXT; | |
254 cfObject = QCF_UNICODETEXT; | |
255 } | |
256 else | |
257 { | |
258 cfType = CF_TEXT; | |
259 cfObject = QCF_TEXT; | |
260 } | |
442 | 261 is_X_type = TRUE; |
262 } | |
263 else | |
264 { | |
265 cfType = symbol_to_ms_cf (selection_type); | |
266 | |
267 /* Only continue if we can figure out a clipboard type */ | |
268 if (!cfType) | |
269 return Qnil; | |
270 | |
271 cfObject = selection_type; | |
272 } | |
273 | |
274 /* Convert things appropriately */ | |
275 data = select_convert_out (selection_name, | |
276 cfObject, | |
277 selection_value); | |
428 | 278 |
442 | 279 if (NILP (data)) |
280 return Qnil; | |
281 | |
282 if (CONSP (data)) | |
283 { | |
284 if (!EQ (XCAR (data), cfObject)) | |
285 cfType = symbol_to_ms_cf (XCAR (data)); | |
286 | |
287 if (!cfType) | |
288 return Qnil; | |
289 | |
290 data = XCDR (data); | |
291 } | |
292 | |
293 /* We support opaque or string values, but we only mention string | |
771 | 294 values for now... |
295 #### where do the opaque objects come from? currently they're not | |
296 allowed to be exported to the lisp level! */ | |
442 | 297 if (!OPAQUEP (data) |
298 && !STRINGP (data)) | |
299 return Qnil; | |
300 | |
301 /* Find the frame */ | |
430 | 302 f = selected_frame (); |
442 | 303 |
304 /* Open the clipboard */ | |
430 | 305 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) |
428 | 306 return Qnil; |
307 | |
771 | 308 /* Obtain the data */ |
309 if (OPAQUEP (data)) | |
310 { | |
311 src = XOPAQUE_DATA (data); | |
312 size = XOPAQUE_SIZE (data); | |
313 } | |
314 else | |
315 /* we do NOT append a zero byte. we don't know whether we're dealing | |
316 with regular text, unicode text, binary data, etc. */ | |
851 | 317 TO_EXTERNAL_FORMAT (LISP_STRING, data, MALLOC, (src, size), |
771 | 318 Qbinary); |
319 | |
442 | 320 /* Allocate memory */ |
321 hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size); | |
322 | |
323 if (!hValue) | |
428 | 324 { |
325 CloseClipboard (); | |
442 | 326 |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
327 xfree (src); |
442 | 328 return Qnil; |
329 } | |
330 | |
331 dst = GlobalLock (hValue); | |
332 | |
333 if (!dst) | |
334 { | |
335 GlobalFree (hValue); | |
336 CloseClipboard (); | |
337 | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
338 xfree (src); |
428 | 339 return Qnil; |
340 } | |
442 | 341 |
342 memcpy (dst, src, size); | |
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
343 xfree (src); |
442 | 344 |
345 GlobalUnlock (hValue); | |
346 | |
347 /* Empty the clipboard if we're replacing everything */ | |
348 if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all)) | |
428 | 349 { |
771 | 350 if (!mswindows_empty_clipboard ()) |
428 | 351 { |
442 | 352 CloseClipboard (); |
353 GlobalFree (hValue); | |
354 | |
355 return Qnil; | |
356 } | |
428 | 357 } |
442 | 358 |
359 /* Append is currently handled in select.el; perhaps this should change, | |
360 but it only really makes sense for ordinary text in any case... */ | |
361 | |
362 SetClipboardData (cfType, hValue); | |
363 | |
364 if (!cf_is_autofreed (cfType)) | |
365 { | |
366 Lisp_Object alist_elt = Qnil, rest; | |
367 Lisp_Object cfType_int = make_int (cfType); | |
368 | |
369 /* First check if there's an element in the alist for this type | |
370 already. */ | |
371 alist_elt = assq_no_quit (cfType_int, Vhandle_alist); | |
372 | |
373 /* Add an element to the alist */ | |
374 Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)), | |
375 Vhandle_alist); | |
376 | |
377 if (!NILP (alist_elt)) | |
378 { | |
379 /* Free the original handle */ | |
380 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt))); | |
381 | |
771 | 382 /* Remove the original one (adding first makes life easier, |
383 because we don't have to special case this being the | |
384 first element) */ | |
442 | 385 for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest)) |
386 if (EQ (cfType_int, Fcar (XCDR (rest)))) | |
387 { | |
388 XCDR (rest) = Fcdr (XCDR (rest)); | |
389 break; | |
390 } | |
391 } | |
392 } | |
393 | |
428 | 394 CloseClipboard (); |
442 | 395 |
396 /* #### Should really return a time, though this is because of the | |
397 X model (by the looks of things) */ | |
398 return Qnil; | |
428 | 399 } |
400 | |
401 static Lisp_Object | |
442 | 402 mswindows_available_selection_types (Lisp_Object selection_name) |
403 { | |
404 Lisp_Object types = Qnil; | |
405 UINT format = 0; | |
406 struct frame *f = NULL; | |
407 | |
408 if (!EQ (selection_name, QCLIPBOARD)) | |
409 return Qnil; | |
410 | |
411 /* Find the frame */ | |
412 f = selected_frame (); | |
413 | |
414 /* Open the clipboard */ | |
415 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) | |
416 return Qnil; | |
417 | |
771 | 418 /* [[ ajh - Should there be an unwind-protect handler around this? |
419 It could (well it probably won't, but it's always better to | |
420 be safe) run out of memory and leave the clipboard open... ]] | |
421 -- xemacs in general makes no provisions for out-of-memory errors; | |
422 we will probably just crash. fixing this is a huge amount of work, | |
423 so don't bother protecting in this case. --ben */ | |
442 | 424 |
425 while ((format = EnumClipboardFormats (format))) | |
426 types = Fcons (ms_cf_to_symbol (format), types); | |
427 | |
428 /* Close it */ | |
429 CloseClipboard (); | |
430 | |
431 return types; | |
432 } | |
433 | |
434 static Lisp_Object | |
435 mswindows_register_selection_data_type (Lisp_Object type_name) | |
428 | 436 { |
442 | 437 /* Type already checked in select.c */ |
771 | 438 Extbyte *nameext; |
439 UINT format; | |
442 | 440 |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
441 nameext = LISP_STRING_TO_TSTR (type_name); |
771 | 442 format = qxeRegisterClipboardFormat (nameext); |
442 | 443 |
444 if (format) | |
445 return make_int ((int) format); | |
446 else | |
447 return Qnil; | |
448 } | |
449 | |
450 static Lisp_Object | |
451 mswindows_selection_data_type_name (Lisp_Object type_id) | |
452 { | |
771 | 453 UINT format; |
454 Extbyte *namebuf; | |
455 int numchars; | |
442 | 456 |
457 /* If it's an integer, convert to a symbol if appropriate */ | |
458 if (INTP (type_id)) | |
459 type_id = ms_cf_to_symbol (XINT (type_id)); | |
460 | |
461 /* If this is a symbol, return it */ | |
462 if (SYMBOLP (type_id)) | |
463 return type_id; | |
464 | |
465 /* Find the format code */ | |
466 format = symbol_to_ms_cf (type_id); | |
467 | |
468 if (!format) | |
469 return Qnil; | |
470 | |
471 /* Microsoft, stupid Microsoft */ | |
771 | 472 { |
800 | 473 int size = 64; |
771 | 474 do |
475 { | |
800 | 476 size *= 2; |
771 | 477 namebuf = alloca_extbytes (size * XETCHAR_SIZE); |
478 numchars = qxeGetClipboardFormatName (format, namebuf, size); | |
479 } | |
480 while (numchars >= size - 1); | |
481 } | |
442 | 482 |
483 if (numchars) | |
771 | 484 return build_tstr_string (namebuf); |
428 | 485 |
486 return Qnil; | |
487 } | |
488 | |
442 | 489 static Lisp_Object |
490 mswindows_get_foreign_selection (Lisp_Object selection_symbol, | |
491 Lisp_Object target_type) | |
428 | 492 { |
442 | 493 HGLOBAL hValue = NULL; |
494 UINT cfType; | |
495 Lisp_Object cfObject = Qnil, ret = Qnil, value = Qnil; | |
496 int is_X_type = FALSE; | |
497 int size; | |
498 void *data; | |
499 struct frame *f = NULL; | |
500 struct gcpro gcpro1; | |
501 | |
502 /* Only continue if we're trying to read the clipboard - mswindows doesn't | |
503 use the same selection model as X */ | |
504 if (!EQ (selection_symbol, QCLIPBOARD)) | |
505 return Qnil; | |
428 | 506 |
442 | 507 /* If this is one of the X-style atom name symbols, or NIL, convert it |
508 as appropriate */ | |
509 if (NILP (target_type) || x_sym_p (target_type)) | |
510 { | |
511 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */ | |
771 | 512 if (XEUNICODE_P) |
513 { | |
514 cfType = CF_UNICODETEXT; | |
515 cfObject = QCF_UNICODETEXT; | |
516 } | |
517 else | |
518 { | |
519 cfType = CF_TEXT; | |
520 cfObject = QCF_TEXT; | |
521 } | |
442 | 522 is_X_type = TRUE; |
523 } | |
524 else | |
525 { | |
526 cfType = symbol_to_ms_cf (target_type); | |
527 | |
528 /* Only continue if we can figure out a clipboard type */ | |
529 if (!cfType) | |
530 return Qnil; | |
531 | |
532 cfObject = ms_cf_to_symbol (cfType); | |
533 } | |
534 | |
535 /* Find the frame */ | |
536 f = selected_frame (); | |
537 | |
538 /* Open the clipboard */ | |
539 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) | |
428 | 540 return Qnil; |
541 | |
442 | 542 /* Read the clipboard */ |
543 hValue = GetClipboardData (cfType); | |
544 | |
545 if (!hValue) | |
428 | 546 { |
442 | 547 CloseClipboard (); |
428 | 548 |
442 | 549 return Qnil; |
550 } | |
428 | 551 |
442 | 552 /* Find the data */ |
553 size = GlobalSize (hValue); | |
554 data = GlobalLock (hValue); | |
428 | 555 |
442 | 556 if (!data) |
557 { | |
558 CloseClipboard (); | |
559 | |
560 return Qnil; | |
428 | 561 } |
562 | |
442 | 563 /* Place it in a Lisp string */ |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
2286
diff
changeset
|
564 ret = make_extstring ((Extbyte *) data, size, Qbinary); |
442 | 565 |
566 GlobalUnlock (data); | |
428 | 567 CloseClipboard (); |
568 | |
442 | 569 GCPRO1 (ret); |
428 | 570 |
442 | 571 /* Convert this to the appropriate type. If we can't find anything, |
572 then we return a cons of the form (DATA-TYPE . STRING), where the | |
573 string contains the raw binary data. */ | |
574 value = select_convert_in (selection_symbol, | |
575 cfObject, | |
576 ret); | |
428 | 577 |
442 | 578 UNGCPRO; |
430 | 579 |
442 | 580 if (NILP (value)) |
581 return Fcons (cfObject, ret); | |
582 else | |
583 return value; | |
428 | 584 } |
585 | |
586 static void | |
2286 | 587 mswindows_disown_selection (Lisp_Object selection, |
588 Lisp_Object UNUSED (timeval)) | |
428 | 589 { |
590 if (EQ (selection, QCLIPBOARD)) | |
442 | 591 { |
592 BOOL success = OpenClipboard (NULL); | |
593 if (success) | |
594 { | |
771 | 595 /* the caller calls handle_selection_clear(). */ |
596 success = mswindows_empty_clipboard (); | |
442 | 597 /* Close it regardless of whether empty worked. */ |
598 if (!CloseClipboard ()) | |
599 success = FALSE; | |
600 } | |
601 | |
602 /* #### return success ? Qt : Qnil; */ | |
603 } | |
604 } | |
605 | |
606 void | |
607 mswindows_destroy_selection (Lisp_Object selection) | |
608 { | |
609 /* Do nothing if this isn't for the clipboard. */ | |
610 if (!EQ (selection, QCLIPBOARD)) | |
611 return; | |
612 | |
613 /* Right. We need to delete everything in Vhandle_alist. */ | |
614 { | |
615 LIST_LOOP_2 (elt, Vhandle_alist) | |
616 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (elt))); | |
617 } | |
618 | |
619 Vhandle_alist = Qnil; | |
620 } | |
621 | |
622 static Lisp_Object | |
623 mswindows_selection_exists_p (Lisp_Object selection, | |
624 Lisp_Object selection_type) | |
625 { | |
626 /* We used to be picky about the format, but now we support anything. */ | |
627 if (EQ (selection, QCLIPBOARD)) | |
628 { | |
629 if (NILP (selection_type)) | |
630 return CountClipboardFormats () ? Qt : Qnil; | |
631 else | |
632 return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type)) | |
633 ? Qt : Qnil; | |
634 } | |
635 else | |
636 return Qnil; | |
428 | 637 } |
638 | |
639 | |
640 /************************************************************************/ | |
641 /* initialization */ | |
642 /************************************************************************/ | |
643 | |
644 void | |
645 console_type_create_select_mswindows (void) | |
646 { | |
647 CONSOLE_HAS_METHOD (mswindows, own_selection); | |
648 CONSOLE_HAS_METHOD (mswindows, disown_selection); | |
442 | 649 CONSOLE_HAS_METHOD (mswindows, selection_exists_p); |
428 | 650 CONSOLE_HAS_METHOD (mswindows, get_foreign_selection); |
442 | 651 CONSOLE_HAS_METHOD (mswindows, available_selection_types); |
652 CONSOLE_HAS_METHOD (mswindows, register_selection_data_type); | |
653 CONSOLE_HAS_METHOD (mswindows, selection_data_type_name); | |
428 | 654 } |
655 | |
656 void | |
657 syms_of_select_mswindows (void) | |
658 { | |
659 } | |
660 | |
661 void | |
662 vars_of_select_mswindows (void) | |
663 { | |
442 | 664 /* Initialise Vhandle_alist */ |
665 Vhandle_alist = Qnil; | |
666 staticpro (&Vhandle_alist); | |
428 | 667 } |
771 | 668 |
669 void | |
670 init_select_mswindows (void) | |
671 { | |
672 /* Reinitialise Vhandle_alist */ | |
673 /* #### Why do we need to do this? Somehow I added this. --ben */ | |
674 Vhandle_alist = Qnil; | |
675 } |