Mercurial > hg > xemacs-beta
annotate src/select.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 | 8608eadee6ba |
| children | a9094f28f9a9 |
| rev | line source |
|---|---|
| 414 | 1 /* Generic selection processing for XEmacs |
| 2 Copyright (C) 1999 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1999 Andy Piper. | |
| 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 | |
| 24 #include <config.h> | |
| 25 #include "lisp.h" | |
| 26 | |
| 27 #include "buffer.h" | |
| 872 | 28 #include "device-impl.h" |
| 442 | 29 #include "extents.h" |
| 414 | 30 #include "console.h" |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
31 #include "fontcolor.h" |
| 414 | 32 |
| 33 #include "frame.h" | |
| 34 #include "opaque.h" | |
| 35 #include "select.h" | |
| 36 | |
| 442 | 37 /* X Atoms */ |
| 414 | 38 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, |
| 39 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, | |
| 40 QATOM_PAIR, QCOMPOUND_TEXT; | |
| 41 | |
| 442 | 42 /* Windows clipboard formats */ |
| 43 Lisp_Object QCF_TEXT, QCF_BITMAP, QCF_METAFILEPICT, QCF_SYLK, QCF_DIF, | |
| 44 QCF_TIFF, QCF_OEMTEXT, QCF_DIB, QCF_DIBV5, QCF_PALETTE, QCF_PENDATA, | |
| 45 QCF_RIFF, QCF_WAVE, QCF_UNICODETEXT, QCF_ENHMETAFILE, QCF_HDROP, QCF_LOCALE, | |
| 46 QCF_OWNERDISPLAY, QCF_DSPTEXT, QCF_DSPBITMAP, QCF_DSPMETAFILEPICT, | |
| 47 QCF_DSPENHMETAFILE; | |
| 48 | |
| 49 /* Selection strategy symbols */ | |
| 50 Lisp_Object Qreplace_all, Qreplace_existing; | |
| 51 | |
| 414 | 52 /* "Selection owner couldn't convert selection" */ |
| 53 Lisp_Object Qselection_conversion_error; | |
| 54 | |
| 442 | 55 /* A couple of Lisp functions */ |
| 56 Lisp_Object Qselect_convert_in, Qselect_convert_out, Qselect_coerce; | |
| 57 | |
| 58 /* These are alists whose CARs are selection-types (whose names are the same | |
| 59 as the names of X Atoms or Windows clipboard formats) and whose CDRs are | |
| 60 the names of Lisp functions to call to convert the given Emacs selection | |
| 61 value to a string representing the given selection type. This is for | |
| 62 elisp-level extension of the emacs selection handling. | |
| 414 | 63 */ |
| 442 | 64 Lisp_Object Vselection_converter_out_alist; |
| 65 Lisp_Object Vselection_converter_in_alist; | |
| 66 Lisp_Object Vselection_coercion_alist; | |
| 67 Lisp_Object Vselection_appender_alist; | |
| 68 Lisp_Object Vselection_buffer_killed_alist; | |
| 69 Lisp_Object Vselection_coercible_types; | |
| 414 | 70 |
| 71 Lisp_Object Vlost_selection_hooks; | |
| 72 | |
| 73 /* This is an association list whose elements are of the form | |
| 74 ( selection-name selection-value selection-timestamp ) | |
| 75 selection-name is a lisp symbol, whose name is the name of an X Atom. | |
| 442 | 76 selection-value is a list of cons pairs that emacs owns for that selection. |
| 77 Each pair consists of (type . value), where type is nil or a | |
| 78 selection data type, and value is any type of Lisp object. | |
| 414 | 79 selection-timestamp is the time at which emacs began owning this selection, |
| 80 as a cons of two 16-bit numbers (making a 32 bit time). | |
| 81 If there is an entry in this alist, then it can be assumed that emacs owns | |
| 82 that selection. | |
| 83 The only (eq) parts of this list that are visible from elisp are the | |
| 84 selection-values. | |
| 85 */ | |
| 86 Lisp_Object Vselection_alist; | |
| 87 | |
| 442 | 88 /* Given a selection-name and desired type, this looks up our local copy of |
| 89 the selection value and converts it to the type. */ | |
| 414 | 90 static Lisp_Object |
| 91 get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type) | |
| 92 { | |
| 93 Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist); | |
| 94 | |
| 442 | 95 if (!NILP (local_value)) |
| 96 { | |
| 97 Lisp_Object value_list = XCAR (XCDR (local_value)); | |
| 98 Lisp_Object value; | |
| 414 | 99 |
| 442 | 100 /* First try to find an entry of the appropriate type */ |
| 101 value = assq_no_quit (target_type, value_list); | |
| 102 | |
| 103 if (!NILP (value)) | |
| 104 return XCDR (value); | |
| 414 | 105 } |
| 106 | |
| 442 | 107 return Qnil; |
| 414 | 108 } |
| 109 | |
| 3025 | 110 /* #### Should perhaps handle `MULTIPLE'. The code below is now completely |
| 442 | 111 broken due to a re-organization of get_local_selection, but I've left |
| 112 it here should anyone show an interest - ajh */ | |
| 113 #if 0 | |
| 114 else if (CONSP (target_type) && | |
| 115 XCAR (target_type) == QMULTIPLE) | |
| 116 { | |
| 117 Lisp_Object pairs = XCDR (target_type); | |
| 118 int len = XVECTOR_LENGTH (pairs); | |
| 119 int i; | |
| 120 /* If the target is MULTIPLE, then target_type looks like | |
| 121 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ]) | |
| 122 We modify the second element of each pair in the vector and | |
| 123 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ] | |
| 124 */ | |
| 125 for (i = 0; i < len; i++) | |
| 126 { | |
| 127 Lisp_Object pair = XVECTOR_DATA (pairs) [i]; | |
| 128 XVECTOR_DATA (pair) [1] = | |
| 129 x_get_local_selection (XVECTOR_DATA (pair) [0], | |
| 130 XVECTOR_DATA (pair) [1]); | |
| 131 } | |
| 132 return pairs; | |
| 133 } | |
| 134 #endif | |
| 135 | |
| 136 DEFUN ("own-selection-internal", Fown_selection_internal, 2, 5, 0, /* | |
| 444 | 137 Give the selection SELECTION-NAME the value SELECTION-VALUE. |
| 138 SELECTION-NAME is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD. | |
| 139 SELECTION-VALUE is typically a string, or a cons of two markers, but may be | |
| 442 | 140 anything that the functions on selection-converter-out-alist know about. |
| 444 | 141 Optional arg HOW-TO-ADD specifies how the selection will be combined |
| 843 | 142 with any existing selection(s) - see `own-selection' for more |
| 143 information. | |
| 444 | 144 Optional arg DATA-TYPE is a window-system-specific type. |
| 145 Optional arg DEVICE specifies the device on which to assert the selection. | |
| 146 It defaults to the selected device. | |
| 414 | 147 */ |
| 442 | 148 (selection_name, selection_value, how_to_add, data_type, device)) |
| 414 | 149 { |
| 442 | 150 Lisp_Object selection_time, selection_data, prev_value = Qnil, |
| 151 value_list = Qnil; | |
| 152 Lisp_Object prev_real_value = Qnil; | |
| 440 | 153 struct gcpro gcpro1; |
| 458 | 154 int owned_p = 0; |
| 414 | 155 |
| 156 CHECK_SYMBOL (selection_name); | |
| 563 | 157 if (NILP (selection_value)) |
| 158 invalid_argument ("`selection-value' may not be nil", Qunbound); | |
| 414 | 159 |
| 160 if (NILP (device)) | |
| 161 device = Fselected_device (Qnil); | |
| 162 | |
| 442 | 163 if (!EQ (how_to_add, Qappend) && !EQ (how_to_add, Qt) |
| 164 && !EQ (how_to_add, Qreplace_existing) | |
| 165 && !EQ (how_to_add, Qreplace_all) && !NILP (how_to_add)) | |
| 563 | 166 invalid_constant ("`how-to-add' must be nil, append, replace_all, " |
| 167 "replace_existing or t", how_to_add); | |
| 442 | 168 |
| 169 #ifdef MULE | |
| 170 if (NILP (data_type)) | |
| 171 data_type = QCOMPOUND_TEXT; | |
| 172 #else | |
| 173 if (NILP (data_type)) | |
| 174 data_type = QSTRING; | |
| 175 #endif | |
| 176 | |
| 177 /* Examine the how-to-add argument */ | |
| 178 if (EQ (how_to_add, Qreplace_all) || NILP (how_to_add)) | |
| 179 { | |
| 180 Lisp_Object local_selection_data = assq_no_quit (selection_name, | |
| 181 Vselection_alist); | |
| 182 | |
| 183 if (!NILP (local_selection_data)) | |
| 184 { | |
| 458 | 185 owned_p = 1; |
|
5338
8608eadee6ba
Move #'delq, #'delete to Lisp, adding support for sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5176
diff
changeset
|
186 Vselection_alist |
|
8608eadee6ba
Move #'delq, #'delete to Lisp, adding support for sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5176
diff
changeset
|
187 = delq_no_quit (local_selection_data, Vselection_alist); |
| 442 | 188 } |
| 189 } | |
| 190 else | |
| 191 { | |
| 192 /* Look for a previous value */ | |
| 193 prev_value = assq_no_quit (selection_name, Vselection_alist); | |
| 194 | |
| 195 if (!NILP (prev_value)) | |
| 458 | 196 { |
| 197 owned_p = 1; | |
| 198 value_list = XCAR (XCDR (prev_value)); | |
| 199 } | |
| 440 | 200 |
| 442 | 201 if (!NILP (value_list)) |
| 202 prev_real_value = assq_no_quit (data_type, value_list); | |
| 203 } | |
| 204 | |
| 205 /* Append values if necessary */ | |
| 206 if (!NILP (value_list) && (EQ (how_to_add, Qappend) || EQ (how_to_add, Qt))) | |
| 414 | 207 { |
| 442 | 208 /* Did we have anything of this type previously? */ |
| 209 if (!NILP (prev_real_value)) | |
| 210 { | |
| 211 if ((NILP (data_type) && STRINGP (selection_value) | |
| 212 && STRINGP (XCDR (prev_real_value))) | |
| 213 || !NILP (data_type)) | |
| 214 { | |
| 215 Lisp_Object function = assq_no_quit (data_type, | |
| 216 Vselection_appender_alist); | |
| 217 | |
| 218 if (NILP (function)) | |
| 563 | 219 signal_error (Qinvalid_argument, |
| 220 "Cannot append selections of supplied types (no function)", | |
| 221 data_type); | |
| 442 | 222 |
| 223 function = XCDR (function); | |
| 224 | |
| 225 selection_value = call4 (function, | |
| 226 selection_name, | |
| 227 data_type, | |
| 228 XCDR (prev_real_value), | |
| 229 selection_value); | |
| 230 | |
| 231 if (NILP (selection_value)) | |
| 563 | 232 signal_error (Qinvalid_argument, |
| 233 "Cannot append selections of supplied types (function returned nil)", | |
| 234 data_type); | |
| 442 | 235 } |
| 236 else | |
| 563 | 237 signal_error_2 (Qinvalid_argument, "Cannot append selections of supplied types (data type nil and both values not strings)", |
| 238 XCDR (prev_real_value), | |
| 239 selection_value); | |
| 442 | 240 } |
| 241 | |
| 242 selection_data = Fcons (data_type, selection_value); | |
| 243 value_list = Fcons (selection_data, value_list); | |
| 244 } | |
| 245 | |
| 246 if (!NILP (prev_real_value)) | |
| 247 { | |
| 248 Lisp_Object rest; /* We know it isn't the CAR, so it's easy. */ | |
| 249 | |
| 250 /* Delete the old type entry from the list */ | |
| 251 for (rest = value_list; !NILP (rest); rest = Fcdr (rest)) | |
| 252 if (EQ (prev_real_value, Fcar (XCDR (rest)))) | |
| 414 | 253 { |
| 254 XCDR (rest) = Fcdr (XCDR (rest)); | |
| 255 break; | |
| 256 } | |
| 257 } | |
| 442 | 258 else |
| 259 { | |
| 260 value_list = Fcons (Fcons (data_type, selection_value), | |
| 261 value_list); | |
| 262 } | |
| 414 | 263 |
| 442 | 264 /* Complete the local cache update; note that we destructively |
| 265 modify the current list entry if there is one */ | |
| 266 if (NILP (prev_value)) | |
| 267 { | |
| 268 selection_data = list3 (selection_name, value_list, Qnil); | |
| 269 Vselection_alist = Fcons (selection_data, Vselection_alist); | |
| 270 } | |
| 271 else | |
| 272 { | |
| 273 selection_data = prev_value; | |
| 274 Fsetcar (XCDR (selection_data), value_list); | |
| 275 } | |
| 276 | |
| 277 GCPRO1 (selection_data); | |
| 278 | |
| 279 /* have to do device specific stuff last so that methods can access the | |
| 414 | 280 selection_alist */ |
| 2620 | 281 |
| 282 /* If you are re-implementing this for another redisplay type, either make | |
| 283 certain that the selection time will fit within thirty-two bits, or | |
| 284 redesign get-xemacs-selection-timestamp to return, say, a bignum, and | |
| 285 convert the device-specific timestamp to a bignum before storing it in | |
| 286 this list. The current practice is to blindly assume that the timestamp | |
| 287 is thirty-two bits, which will work for extant architectures. */ | |
| 288 | |
| 414 | 289 if (HAS_DEVMETH_P (XDEVICE (device), own_selection)) |
| 290 selection_time = DEVMETH (XDEVICE (device), own_selection, | |
| 442 | 291 (selection_name, selection_value, |
| 458 | 292 how_to_add, data_type, owned_p)); |
| 414 | 293 else |
| 294 selection_time = Qnil; | |
| 295 | |
| 296 Fsetcar (XCDR (XCDR (selection_data)), selection_time); | |
| 297 | |
| 440 | 298 UNGCPRO; |
| 299 | |
| 414 | 300 return selection_value; |
| 301 } | |
| 302 | |
| 442 | 303 DEFUN ("register-selection-data-type", Fregister_selection_data_type, 1,2,0, /* |
| 304 Register a new selection data type DATA-TYPE, optionally on the specified | |
| 305 DEVICE. Returns the device-specific data type identifier, or nil if the | |
| 306 device does not support this feature or the registration fails. */ | |
| 307 (data_type, device)) | |
| 308 { | |
| 309 /* Check arguments */ | |
| 310 CHECK_STRING (data_type); | |
| 311 | |
| 312 if (NILP (device)) | |
| 313 device = Fselected_device (Qnil); | |
| 314 | |
| 315 if (HAS_DEVMETH_P (XDEVICE (device), register_selection_data_type)) | |
| 316 return DEVMETH (XDEVICE (device), register_selection_data_type, | |
| 317 (data_type)); | |
| 318 else | |
| 319 return Qnil; | |
| 320 } | |
| 321 | |
| 322 DEFUN ("selection-data-type-name", Fselection_data_type_name, 1, 2, 0, /* | |
| 323 Retrieve the name of the specified selection data type DATA-TYPE, optionally | |
| 324 on the specified DEVICE. Returns either a string or a symbol on success, and | |
| 325 nil if the device does not support this feature or the type is not known. */ | |
| 326 (data_type, device)) | |
| 327 { | |
| 328 if (NILP (device)) | |
| 329 device = Fselected_device (Qnil); | |
| 330 | |
| 331 if (HAS_DEVMETH_P (XDEVICE (device), selection_data_type_name)) | |
| 332 return DEVMETH (XDEVICE (device), selection_data_type_name, (data_type)); | |
| 333 else | |
| 334 return Qnil; | |
| 335 } | |
| 336 | |
| 337 DEFUN ("available-selection-types", Favailable_selection_types, 1, 2, 0, /* | |
| 338 Retrieve a list of currently available types of selection associated with | |
| 339 the given SELECTION-NAME, optionally on the specified DEVICE. This list | |
| 340 does not take into account any possible conversions that might take place, | |
| 341 so it should be taken as a minimal estimate of what is available. | |
| 342 */ | |
| 343 (selection_name, device)) | |
| 344 { | |
| 345 Lisp_Object types = Qnil, rest; | |
| 346 struct gcpro gcpro1; | |
| 347 | |
| 348 CHECK_SYMBOL (selection_name); | |
| 349 | |
| 350 if (NILP (device)) | |
| 351 device = Fselected_device (Qnil); | |
| 352 | |
| 353 GCPRO1 (types); | |
| 354 | |
| 355 /* First check the device */ | |
| 356 if (HAS_DEVMETH_P (XDEVICE (device), available_selection_types)) | |
| 357 types = DEVMETH (XDEVICE (device), available_selection_types, | |
| 358 (selection_name)); | |
| 359 | |
| 360 /* Now look in the list */ | |
| 361 rest = assq_no_quit (selection_name, Vselection_alist); | |
| 362 | |
| 363 if (NILP (rest)) | |
| 364 { | |
| 365 UNGCPRO; | |
| 366 | |
| 367 return types; | |
| 368 } | |
| 369 | |
| 370 /* Examine the types and cons them onto the front of the list */ | |
| 371 for (rest = XCAR (XCDR (rest)); !NILP (rest); rest = XCDR (rest)) | |
| 372 { | |
| 373 Lisp_Object value = XCDR (XCAR (rest)); | |
| 374 Lisp_Object type = XCAR (XCAR (rest)); | |
| 375 | |
| 376 types = Fcons (type, types); | |
| 377 | |
| 378 if ((STRINGP (value) || EXTENTP (value)) | |
| 379 && (NILP (type) || EQ (type, QSTRING) | |
| 380 || EQ (type, QTEXT) || EQ (type, QCOMPOUND_TEXT))) | |
| 381 types = Fcons (QTEXT, Fcons (QCOMPOUND_TEXT, Fcons (QSTRING, types))); | |
| 382 else if (INTP (value) && NILP (type)) | |
| 383 types = Fcons (QINTEGER, types); | |
| 384 else if (SYMBOLP (value) && NILP (type)) | |
| 385 types = Fcons (QATOM, types); | |
| 386 } | |
| 387 | |
| 388 UNGCPRO; | |
| 389 | |
| 390 return types; | |
| 391 } | |
| 392 | |
| 414 | 393 /* remove a selection from our local copy |
| 394 */ | |
| 395 void | |
| 396 handle_selection_clear (Lisp_Object selection_symbol) | |
| 397 { | |
| 442 | 398 Lisp_Object local_selection_data = assq_no_quit (selection_symbol, |
| 399 Vselection_alist); | |
| 414 | 400 |
| 401 /* Well, we already believe that we don't own it, so that's just fine. */ | |
| 402 if (NILP (local_selection_data)) return; | |
| 403 | |
|
5338
8608eadee6ba
Move #'delq, #'delete to Lisp, adding support for sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5176
diff
changeset
|
404 /* Otherwise, we're really honest and truly being told to drop it. */ |
|
8608eadee6ba
Move #'delq, #'delete to Lisp, adding support for sequences.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5176
diff
changeset
|
405 Vselection_alist = delq_no_quit (local_selection_data, Vselection_alist); |
| 414 | 406 |
| 407 /* Let random lisp code notice that the selection has been stolen. | |
| 408 */ | |
| 409 { | |
| 410 Lisp_Object rest; | |
| 411 Lisp_Object val = Vlost_selection_hooks; | |
| 412 if (!UNBOUNDP (val) && !NILP (val)) | |
| 413 { | |
| 414 if (CONSP (val) && !EQ (XCAR (val), Qlambda)) | |
| 415 for (rest = val; !NILP (rest); rest = Fcdr (rest)) | |
| 416 call1 (Fcar (rest), selection_symbol); | |
| 417 else | |
| 418 call1 (val, selection_symbol); | |
| 419 } | |
| 420 } | |
| 421 } | |
| 422 | |
| 423 DEFUN ("disown-selection-internal", Fdisown_selection_internal, 1, 3, 0, /* | |
| 424 If we own the named selection, then disown it (make there be no selection). | |
| 425 */ | |
| 426 (selection_name, selection_time, device)) | |
| 427 { | |
| 428 if (NILP (assq_no_quit (selection_name, Vselection_alist))) | |
| 429 return Qnil; /* Don't disown the selection when we're not the owner. */ | |
| 430 | |
| 431 if (NILP (device)) | |
| 432 device = Fselected_device (Qnil); | |
| 433 | |
| 434 MAYBE_DEVMETH (XDEVICE (device), disown_selection, | |
| 435 (selection_name, selection_time)); | |
| 442 | 436 |
| 414 | 437 handle_selection_clear (selection_name); |
| 438 | |
| 439 return Qt; | |
| 440 } | |
| 441 | |
| 442 DEFUN ("selection-owner-p", Fselection_owner_p, 0, 1, 0, /* | |
| 444 | 443 Return t if the current emacs process owns SELECTION. |
| 444 SELECTION should be the name of the selection in question, typically one of | |
| 414 | 445 the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol |
| 446 nil is the same as PRIMARY, and t is the same as SECONDARY.) | |
| 447 */ | |
| 448 (selection)) | |
| 449 { | |
| 450 CHECK_SYMBOL (selection); | |
| 451 if (EQ (selection, Qnil)) selection = QPRIMARY; | |
| 452 else if (EQ (selection, Qt)) selection = QSECONDARY; | |
| 453 | |
| 454 return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt; | |
| 455 } | |
| 456 | |
| 442 | 457 DEFUN ("selection-exists-p", Fselection_exists_p, 0, 3, 0, /* |
| 444 | 458 Whether there is currently an owner for SELECTION. |
| 459 SELECTION should be the name of the selection in question, typically one of | |
| 414 | 460 the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol |
| 461 nil is the same as PRIMARY, and t is the same as SECONDARY.) | |
| 444 | 462 Optionally, the window-system DATA-TYPE and the DEVICE may be specified. |
| 414 | 463 */ |
| 442 | 464 (selection, data_type, device)) |
| 414 | 465 { |
| 466 CHECK_SYMBOL (selection); | |
| 442 | 467 if (NILP (data_type) |
| 468 && !NILP (Fselection_owner_p (selection))) | |
| 414 | 469 return Qt; |
| 470 | |
| 471 if (NILP (device)) | |
| 472 device = Fselected_device (Qnil); | |
| 473 | |
| 474 return HAS_DEVMETH_P (XDEVICE (device), selection_exists_p) ? | |
| 442 | 475 DEVMETH (XDEVICE (device), selection_exists_p, (selection, data_type)) |
| 414 | 476 : Qnil; |
| 477 } | |
| 478 | |
| 2620 | 479 Lisp_Object |
| 480 get_selection_raw_time(Lisp_Object selection) | |
| 481 { | |
| 482 Lisp_Object local_value = assq_no_quit (selection, Vselection_alist); | |
| 483 | |
| 484 if (!NILP (local_value)) | |
| 485 { | |
| 486 return XCAR (XCDR (XCDR (local_value))); | |
| 487 } | |
| 488 return Qnil; | |
| 489 } | |
| 490 | |
| 442 | 491 /* Get the timestamp of the given selection */ |
| 2620 | 492 DEFUN ("get-xemacs-selection-timestamp", Fget_selection_timestamp, 1, 1, 0, /* |
| 2757 | 493 Return timestamp for SELECTION, if it belongs to XEmacs and exists. |
| 2620 | 494 |
| 495 The timestamp is a cons of two integers, the first being the higher-order | |
| 496 sixteen bits of the device-specific thirty-two-bit quantity, the second | |
| 497 being the lower-order sixteen bits of same. Expect to see this API change | |
| 498 when and if redisplay on a window system with timestamps wider than 32bits | |
| 499 happens. | |
| 442 | 500 */ |
| 501 (selection)) | |
| 502 { | |
| 2620 | 503 Lisp_Object val = get_selection_raw_time(selection); |
| 442 | 504 |
| 2620 | 505 if (!NILP (val)) |
| 506 { | |
| 507 return word_to_lisp(* (UINT_32_BIT *) XOPAQUE_DATA (val)); | |
| 508 } | |
| 442 | 509 |
| 510 return Qnil; | |
| 511 } | |
| 512 | |
| 414 | 513 /* Request the selection value from the owner. If we are the owner, |
| 843 | 514 simply return our selection value. If we are not the owner, this |
| 515 will block until all of the data has arrived. | |
| 414 | 516 */ |
| 517 DEFUN ("get-selection-internal", Fget_selection_internal, 2, 3, 0, /* | |
| 518 Return text selected from some window-system window. | |
| 444 | 519 SELECTION is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD. |
| 520 TARGET-TYPE is the type of data desired, typically STRING or COMPOUND_TEXT. | |
| 414 | 521 Under Mule, if the resultant data comes back as 8-bit data in type |
| 522 TEXT or COMPOUND_TEXT, it will be decoded as Compound Text. | |
| 523 */ | |
| 444 | 524 (selection, target_type, device)) |
| 414 | 525 { |
| 526 /* This function can GC */ | |
| 527 Lisp_Object val = Qnil; | |
| 528 struct gcpro gcpro1, gcpro2; | |
| 442 | 529 GCPRO2 (target_type, val); |
| 444 | 530 CHECK_SYMBOL (selection); |
| 414 | 531 |
| 532 if (NILP (device)) | |
| 533 device = Fselected_device (Qnil); | |
| 534 | |
| 442 | 535 #ifdef MULE |
| 536 if (NILP (target_type)) | |
| 537 target_type = QCOMPOUND_TEXT; | |
| 538 #else | |
| 539 if (NILP (target_type)) | |
| 540 target_type = QSTRING; | |
| 541 #endif | |
| 542 | |
| 414 | 543 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */ |
| 544 if (CONSP (target_type) && | |
| 545 XCAR (target_type) == QMULTIPLE) | |
| 546 { | |
| 547 CHECK_VECTOR (XCDR (target_type)); | |
| 548 /* So we don't destructively modify this... */ | |
| 549 target_type = copy_multiple_data (target_type); | |
| 550 } | |
| 551 #endif | |
| 442 | 552 |
| 553 /* Used to check that target_type was a symbol. This is no longer | |
| 554 necessarily the case, because the type might be registered with | |
| 555 the device (in which case target_type would be a device-specific | |
| 556 identifier - probably an integer) - ajh */ | |
| 414 | 557 |
| 444 | 558 val = get_local_selection (selection, target_type); |
| 414 | 559 |
| 442 | 560 if (!NILP (val)) |
| 414 | 561 { |
| 442 | 562 /* If we get something from the local cache, we may need to convert |
| 563 it slightly - to do this, we call select-coerce */ | |
| 843 | 564 val = call3 (Qselect_coerce, selection, target_type, val); |
| 442 | 565 } |
| 566 else if (HAS_DEVMETH_P (XDEVICE (device), get_foreign_selection)) | |
| 567 { | |
| 568 /* Nothing in the local cache; try the window system */ | |
| 414 | 569 val = DEVMETH (XDEVICE (device), get_foreign_selection, |
| 444 | 570 (selection, target_type)); |
| 414 | 571 } |
| 442 | 572 |
| 573 if (NILP (val)) | |
| 414 | 574 { |
| 442 | 575 /* Still nothing. Try coercion. */ |
| 576 | |
| 577 /* Try looking in selection-coercible-types to see if any of | |
| 578 them are present for this selection. We try them *in order*; | |
| 579 the first for which a conversion succeeds gets returned. */ | |
| 580 EXTERNAL_LIST_LOOP_2 (element, Vselection_coercible_types) | |
| 414 | 581 { |
| 444 | 582 val = get_local_selection (selection, element); |
| 442 | 583 |
| 584 if (NILP (val)) | |
| 585 continue; | |
| 586 | |
| 444 | 587 val = call3 (Qselect_coerce, selection, target_type, val); |
| 442 | 588 |
| 589 if (!NILP (val)) | |
| 590 break; | |
| 414 | 591 } |
| 592 } | |
| 442 | 593 |
| 594 /* Used to call clean_local_selection here... but that really belonged | |
| 595 in Lisp (so the equivalent is now built-in to the INTEGER conversion | |
| 596 function select-convert-from-integer) - ajh */ | |
| 597 | |
| 414 | 598 UNGCPRO; |
| 599 return val; | |
| 600 } | |
| 601 | |
| 442 | 602 /* These are convenient interfaces to the lisp code in select.el; |
| 603 this way we can rename them easily rather than having to hunt everywhere. | |
| 604 Also, this gives us access to get_local_selection so that convert_out | |
| 605 can retrieve the internal selection value automatically if passed a | |
| 606 value of Qnil. */ | |
| 607 Lisp_Object | |
| 608 select_convert_in (Lisp_Object selection, | |
| 609 Lisp_Object type, | |
| 610 Lisp_Object value) | |
| 611 { | |
| 612 return call3 (Qselect_convert_in, selection, type, value); | |
| 613 } | |
| 614 | |
| 615 Lisp_Object | |
| 616 select_coerce (Lisp_Object selection, | |
| 617 Lisp_Object type, | |
| 618 Lisp_Object value) | |
| 619 { | |
| 620 return call3 (Qselect_coerce, selection, type, value); | |
| 621 } | |
| 622 | |
| 623 Lisp_Object | |
| 624 select_convert_out (Lisp_Object selection, | |
| 625 Lisp_Object type, | |
| 626 Lisp_Object value) | |
| 627 { | |
| 628 if (NILP (value)) | |
| 629 value = get_local_selection (selection, type); | |
| 630 | |
| 631 if (NILP (value)) | |
| 632 { | |
| 633 /* Try looking in selection-coercible-types to see if any of | |
| 634 them are present for this selection. We try them *in order*; | |
| 635 the first for which a conversion succeeds gets returned. */ | |
| 636 EXTERNAL_LIST_LOOP_2 (element, Vselection_coercible_types) | |
| 637 { | |
| 638 Lisp_Object ret; | |
| 639 | |
| 640 value = get_local_selection (selection, element); | |
| 641 | |
| 642 if (NILP (value)) | |
| 643 continue; | |
| 644 | |
| 645 ret = call3 (Qselect_convert_out, selection, type, value); | |
| 646 | |
| 647 if (!NILP (ret)) | |
| 648 return ret; | |
| 649 } | |
| 650 | |
| 651 return Qnil; | |
| 652 } | |
| 653 | |
| 654 return call3 (Qselect_convert_out, selection, type, value); | |
| 655 } | |
| 656 | |
| 657 | |
| 658 /* Gets called from kill-buffer; this lets us dispose of buffer-dependent | |
| 659 selections (or alternatively make them independent of the buffer) when | |
| 660 it gets vaped. */ | |
| 661 void | |
| 662 select_notify_buffer_kill (Lisp_Object buffer) | |
| 663 { | |
| 664 Lisp_Object rest; | |
| 665 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 666 | |
| 667 /* For each element of Vselection_alist */ | |
| 668 for (rest = Vselection_alist; | |
| 669 !NILP (rest);) | |
| 670 { | |
| 671 Lisp_Object selection, values, prev = Qnil; | |
| 672 | |
| 673 selection = XCAR (rest); | |
| 674 | |
| 675 for (values = XCAR (XCDR (selection)); | |
| 676 !NILP (values); | |
| 677 values = XCDR (values)) | |
| 678 { | |
| 679 Lisp_Object value, handler_fn; | |
| 680 | |
| 681 /* Extract the (type . value) pair. */ | |
| 682 value = XCAR (values); | |
| 683 | |
| 684 /* Find the handler function (if any). */ | |
| 685 handler_fn = Fcdr (Fassq (XCAR (value), | |
| 686 Vselection_buffer_killed_alist)); | |
| 687 | |
| 688 if (!NILP (handler_fn)) | |
| 689 { | |
| 690 Lisp_Object newval; | |
| 691 | |
| 692 /* Protect ourselves, just in case some tomfool calls | |
| 693 own-selection from with the buffer-killed handler, then | |
| 694 causes a GC. Just as a note, *don't do this*. */ | |
| 695 GCPRO3 (rest, values, value); | |
| 696 | |
| 697 newval = call4 (handler_fn, XCAR (selection), XCAR (value), | |
| 698 XCDR (value), buffer); | |
| 699 | |
| 700 UNGCPRO; | |
| 701 | |
| 702 /* Set or delete the value (by destructively modifying | |
| 703 the list). */ | |
| 704 if (!NILP (newval)) | |
| 705 { | |
| 706 Fsetcdr (value, newval); | |
| 707 | |
| 708 prev = values; | |
| 709 } | |
| 710 else | |
| 711 { | |
| 712 if (NILP (prev)) | |
| 713 Fsetcar (XCDR (selection), XCDR (values)); | |
| 714 else | |
| 715 Fsetcdr (prev, XCDR (values)); | |
| 716 } | |
| 717 } | |
| 718 else | |
| 719 prev = values; | |
| 720 } | |
| 721 | |
| 722 /* If we have no values for this selection */ | |
| 723 if (NILP (XCAR (XCDR (selection)))) | |
| 724 { | |
| 725 /* Move on to the next element *first* */ | |
| 726 rest = XCDR (rest); | |
| 727 | |
| 728 /* Protect it and disown this selection */ | |
| 729 GCPRO1 (rest); | |
| 730 | |
| 731 Fdisown_selection_internal (XCAR (selection), Qnil, Qnil); | |
| 732 | |
| 733 UNGCPRO; | |
| 734 } | |
| 735 else | |
| 736 rest = XCDR (rest); | |
| 737 } | |
| 738 } | |
| 739 | |
| 740 | |
| 414 | 741 void |
| 742 syms_of_select (void) | |
| 743 { | |
| 744 DEFSUBR (Fown_selection_internal); | |
| 745 DEFSUBR (Fget_selection_internal); | |
| 442 | 746 DEFSUBR (Fget_selection_timestamp); |
| 414 | 747 DEFSUBR (Fselection_exists_p); |
| 748 DEFSUBR (Fdisown_selection_internal); | |
| 749 DEFSUBR (Fselection_owner_p); | |
| 442 | 750 DEFSUBR (Favailable_selection_types); |
| 751 DEFSUBR (Fregister_selection_data_type); | |
| 752 DEFSUBR (Fselection_data_type_name); | |
| 414 | 753 |
| 442 | 754 /* Lisp Functions */ |
| 563 | 755 DEFSYMBOL (Qselect_convert_in); |
| 756 DEFSYMBOL (Qselect_convert_out); | |
| 757 DEFSYMBOL (Qselect_coerce); | |
| 442 | 758 |
| 759 /* X Atoms */ | |
| 563 | 760 DEFSYMBOL (QPRIMARY); |
| 761 DEFSYMBOL (QSECONDARY); | |
| 762 DEFSYMBOL (QSTRING); | |
| 763 DEFSYMBOL (QINTEGER); | |
| 764 DEFSYMBOL (QCLIPBOARD); | |
| 765 DEFSYMBOL (QTIMESTAMP); | |
| 766 DEFSYMBOL (QTEXT); | |
| 767 DEFSYMBOL (QDELETE); | |
| 768 DEFSYMBOL (QMULTIPLE); | |
| 769 DEFSYMBOL (QINCR); | |
| 414 | 770 defsymbol (&QEMACS_TMP, "_EMACS_TMP_"); |
| 563 | 771 DEFSYMBOL (QTARGETS); |
| 772 DEFSYMBOL (QATOM); | |
| 414 | 773 defsymbol (&QATOM_PAIR, "ATOM_PAIR"); |
| 774 defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT"); | |
| 563 | 775 DEFSYMBOL (QNULL); |
| 414 | 776 |
| 442 | 777 /* Windows formats - these all start with CF_ */ |
| 778 defsymbol (&QCF_TEXT, "CF_TEXT"); | |
| 779 defsymbol (&QCF_BITMAP, "CF_BITMAP"); | |
| 780 defsymbol (&QCF_METAFILEPICT, "CF_METAFILEPICT"); | |
| 781 defsymbol (&QCF_SYLK, "CF_SYLK"); | |
| 782 defsymbol (&QCF_DIF, "CF_DIF"); | |
| 783 defsymbol (&QCF_TIFF, "CF_TIFF"); | |
| 784 defsymbol (&QCF_OEMTEXT, "CF_OEMTEXT"); | |
| 785 defsymbol (&QCF_DIB, "CF_DIB"); | |
| 786 defsymbol (&QCF_DIBV5, "CF_DIBV5"); | |
| 787 defsymbol (&QCF_PALETTE, "CF_PALETTE"); | |
| 788 defsymbol (&QCF_PENDATA, "CF_PENDATA"); | |
| 789 defsymbol (&QCF_RIFF, "CF_RIFF"); | |
| 790 defsymbol (&QCF_WAVE, "CF_WAVE"); | |
| 791 defsymbol (&QCF_UNICODETEXT, "CF_UNICODETEXT"); | |
| 792 defsymbol (&QCF_ENHMETAFILE, "CF_ENHMETAFILE"); | |
| 793 defsymbol (&QCF_HDROP, "CF_HDROP"); | |
| 794 defsymbol (&QCF_LOCALE, "CF_LOCALE"); | |
| 795 defsymbol (&QCF_OWNERDISPLAY, "CF_OWNERDISPLAY"); | |
| 796 defsymbol (&QCF_DSPTEXT, "CF_DSPTEXT"); | |
| 797 defsymbol (&QCF_DSPBITMAP, "CF_DSPBITMAP"); | |
| 798 defsymbol (&QCF_DSPMETAFILEPICT, "CF_DSPMETAFILEPICT"); | |
| 799 defsymbol (&QCF_DSPENHMETAFILE, "CF_DSPENHMETAFILE"); | |
| 800 | |
| 801 /* Selection strategies */ | |
| 563 | 802 DEFSYMBOL (Qreplace_all); |
| 803 DEFSYMBOL (Qreplace_existing); | |
| 442 | 804 |
| 563 | 805 DEFERROR_STANDARD (Qselection_conversion_error, Qconversion_error); |
| 414 | 806 } |
| 807 | |
| 808 void | |
| 809 vars_of_select (void) | |
| 810 { | |
| 811 Vselection_alist = Qnil; | |
| 812 staticpro (&Vselection_alist); | |
| 813 | |
| 442 | 814 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_out_alist /* |
| 815 An alist associating selection-types (such as STRING and TIMESTAMP) with | |
| 816 functions. This is an alias for `selection-converter-out-alist', and should | |
| 817 be considered obsolete. Use the new name instead. */ ); | |
| 818 | |
| 819 DEFVAR_LISP ("selection-converter-out-alist", | |
| 820 &Vselection_converter_out_alist /* | |
| 414 | 821 An alist associating selection-types (such as STRING and TIMESTAMP) with |
| 822 functions. These functions will be called with three args: the name | |
| 823 of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a | |
| 824 desired type to which the selection should be converted; and the local | |
| 442 | 825 selection value (whatever had been passed to `own-selection'). |
| 826 | |
| 827 The return type of these functions depends upon the device in question; | |
| 828 for mswindows, a string should be returned containing data in the requested | |
| 829 format, or nil to indicate that the conversion could not be done. Additionally, | |
| 830 it is permissible to return a cons of the form (DATA-TYPE . STRING) suggesting | |
| 831 a new data type to use instead. | |
| 832 | |
| 833 For X, the return value should be one of: | |
| 414 | 834 |
| 835 -- nil (the conversion could not be done) | |
| 836 -- a cons of a symbol and any of the following values; the symbol | |
| 837 explicitly specifies the type that will be sent. | |
| 838 -- a string (If the type is not specified, then if Mule support exists, | |
| 839 the string will be converted to Compound Text and sent in | |
| 3025 | 840 the `COMPOUND_TEXT' format; otherwise (no Mule support), |
| 841 the string will be left as-is and sent in the `STRING' | |
| 414 | 842 format. If the type is specified, the string will be |
| 843 left as-is (or converted to binary format under Mule). | |
| 844 In all cases, 8-bit data it sent.) | |
| 845 -- a character (With Mule support, will be converted to Compound Text | |
| 846 whether or not a type is specified. If a type is not | |
| 3025 | 847 specified, a type of `STRING' or `COMPOUND_TEXT' will be |
| 414 | 848 sent, as for strings.) |
| 3025 | 849 -- the symbol `NULL' (Indicates that there is no meaningful return value. |
| 850 Empty 32-bit data with a type of `NULL' will be sent.) | |
| 414 | 851 -- a symbol (Will be converted into an atom. If the type is not specified, |
| 3025 | 852 a type of `ATOM' will be sent.) |
| 414 | 853 -- an integer (Will be converted into a 16-bit or 32-bit integer depending |
| 854 on the value. If the type is not specified, a type of | |
| 3025 | 855 `INTEGER' will be sent.) |
| 414 | 856 -- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer. |
| 857 If the type is not specified, a type of | |
| 3025 | 858 `INTEGER' will be sent.) |
| 414 | 859 -- a vector of symbols (Will be converted into a list of atoms. If the type |
| 3025 | 860 is not specified, a type of `ATOM' will be sent.) |
| 414 | 861 -- a vector of integers (Will be converted into a list of 16-bit integers. |
| 3025 | 862 If the type is not specified, a type of `INTEGER' |
| 414 | 863 will be sent.) |
| 864 -- a vector of integers and/or conses (HIGH . LOW) of integers | |
| 865 (Will be converted into a list of 16-bit integers. | |
| 3025 | 866 If the type is not specified, a type of `INTEGER' |
| 442 | 867 will be sent.) |
| 868 */ ); | |
| 869 Vselection_converter_out_alist = Qnil; | |
| 870 | |
| 871 DEFVAR_LISP ("selection-converter-in-alist", | |
| 872 &Vselection_converter_in_alist /* | |
| 873 An alist associating selection-types (such as STRING and TIMESTAMP) with | |
| 874 functions. These functions will be called with three args: the name | |
| 875 of the selection (typically PRIMARY, SECONDARY or CLIPBOARD); the | |
| 876 type from which the selection should be converted; and the selection | |
| 877 value. These functions should return a suitable representation of the | |
| 878 value, or nil to indicate that the conversion was not possible. | |
| 879 | |
| 880 See also `selection-converter-out-alist'. */ ); | |
| 881 Vselection_converter_in_alist = Qnil; | |
| 882 | |
| 883 DEFVAR_LISP ("selection-coercion-alist", | |
| 884 &Vselection_coercion_alist /* | |
| 885 An alist associating selection-types (such as STRING and TIMESTAMP) with | |
| 886 functions. These functions will be called with three args; the name | |
| 887 of the selection (typically PRIMARY, SECONDARY or CLIPBOARD); the type | |
| 888 from which the selection should be converted, and the selection value. | |
| 889 The value passed will be *exactly the same value* that was given to | |
| 890 `own-selection'; it should be converted into something suitable for | |
| 891 return to a program calling `get-selection' with the appropriate | |
| 892 parameters. | |
| 893 | |
| 894 See also `selection-converter-in-alist' and | |
| 895 `selection-converter-out-alist'. */); | |
| 896 Vselection_coercion_alist = Qnil; | |
| 897 | |
| 898 DEFVAR_LISP ("selection-appender-alist", | |
| 899 &Vselection_appender_alist /* | |
| 900 An alist associating selection-types (such as STRING and TIMESTAMP) with | |
| 901 functions. These functions will be called with four args; the name | |
| 902 of the selection (typically PRIMARY, SECONDARY or CLIPBOARD); the type | |
| 903 of the selection; and two selection values. The functions are expected to | |
| 904 return a value representing the catenation of the two values, or nil to | |
| 905 indicate that this was not possible. */ ); | |
| 906 Vselection_appender_alist = Qnil; | |
| 907 | |
| 908 DEFVAR_LISP ("selection-buffer-killed-alist", | |
| 909 &Vselection_buffer_killed_alist /* | |
| 910 An alist associating selection-types (such as STRING and TIMESTAMP) with | |
| 911 functions. These functions will be called whenever a buffer is killed, | |
| 912 with four args: the name of the selection (typically PRIMARY, SECONDARY | |
| 913 or CLIPBOARD); the type of the selection; the value of the selection; and | |
| 914 the buffer that has just been killed. These functions should return a new | |
| 915 selection value, or nil to indicate that the selection value should be | |
| 916 deleted. */ ); | |
| 917 Vselection_buffer_killed_alist = Qnil; | |
| 918 | |
| 919 DEFVAR_LISP ("selection-coercible-types", | |
| 920 &Vselection_coercible_types /* | |
| 921 A list of selection types that are coercible---that is, types that may be | |
| 922 automatically converted to another type. Selection values with types in this | |
| 923 list may be subject to conversion attempts to other types. */ ); | |
| 924 Vselection_coercible_types = Qnil; | |
| 414 | 925 |
| 926 DEFVAR_LISP ("lost-selection-hooks", &Vlost_selection_hooks /* | |
| 927 A function or functions to be called after we have been notified | |
| 928 that we have lost the selection. The function(s) will be called with one | |
| 929 argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or | |
| 930 CLIPBOARD). | |
| 931 */ ); | |
| 932 Vlost_selection_hooks = Qunbound; | |
| 933 } |