Mercurial > hg > xemacs-beta
annotate src/select-x.c @ 4953:304aebb79cd3
function renamings to track names of char typedefs
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-01-27 Ben Wing <ben@xemacs.org>
* internals/internals.texi (lrecords):
* internals/internals.texi (The DFC API):
* internals/internals.texi (Conversion to and from External Data):
* internals/internals.texi (Mule-izing Code):
* internals/internals.texi (Pervasive changes throughout XEmacs sources):
* internals/internals.texi (Ben's README):
* internals/internals.texi (Future Work -- Localized Text/Messages):
* emodules.texi (Defining Variables):
Rename:
write_c_string -> write_cistring
build_intstring -> build_istring
build_string -> build_cistring
build_ext_string -> build_extstring
make_ext_string -> make_extstring
buffer_insert_c_string -> buffer_insert_ascstring
intern_int -> intern_istring
See comment in src/ChangeLog about this.
modules/ChangeLog addition:
2010-01-27 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (print_pgconn):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_pgconn):
* postgresql/postgresql.c (Fpq_res_status):
* postgresql/postgresql.c (Fpq_result_error_message):
* postgresql/postgresql.c (Fpq_fname):
* postgresql/postgresql.c (Fpq_get_value):
* postgresql/postgresql.c (Fpq_cmd_status):
* postgresql/postgresql.c (Fpq_cmd_tuples):
* postgresql/postgresql.c (Fpq_notifies):
* postgresql/postgresql.c (Fpq_get_line):
* postgresql/postgresql.c (Fpq_get_line_async):
* postgresql/postgresql.c (FROB):
* postgresql/postgresql.c (init_postgresql_from_environment):
* ldap/eldap.c:
* ldap/eldap.c (Fldap_open):
* ldap/eldap.c (Fldap_search_basic):
* canna/canna_api.c:
* canna/canna_api.c (make_euc_string):
Rename:
write_c_string -> write_cistring
build_intstring -> build_istring
build_string -> build_cistring
build_ext_string -> build_extstring
make_ext_string -> make_extstring
buffer_insert_c_string -> buffer_insert_ascstring
intern_int -> intern_istring
See comment in src/ChangeLog about this.
src/ChangeLog addition:
2010-01-27 Ben Wing <ben@xemacs.org>
* .gdbinit.in.in:
* README:
* abbrev.c (write_abbrev):
* abbrev.c (describe_abbrev):
* alloc.c (make_extstring):
* alloc.c (build_istring):
* alloc.c (build_cistring):
* alloc.c (build_ascstring):
* alloc.c (build_extstring):
* alloc.c (build_msg_istring):
* alloc.c (build_defer_istring):
* buffer.c (Fgenerate_new_buffer_name):
* buffer.c (init_buffer_2):
* console-tty.c (tty_init_console):
* console-x.c (get_display_arg_connection):
* console-x.c (x_perhaps_init_unseen_key_defaults):
* database.c (dbm_map):
* database.c (dbm_get):
* database.c (berkdb_get):
* database.c (berkdb_map):
* device-gtk.c (FROB_PIXMAP):
* device-gtk.c (Fgtk_style_info):
* device-msw.c (msprinter_default_printer):
* device-msw.c (sync_printer_with_devmode):
* device-x.c (coding_system_of_xrm_database):
* device-x.c (x_init_device):
* device-x.c (signal_if_x_error):
* device-x.c (Fx_get_resource):
* device-x.c (Fx_server_vendor):
* device-x.c (Fx_get_font_path):
* dialog-x.c (maybe_run_dbox_text_callback):
* doc.c (extract_object_file_name):
* doc.c (unparesseuxify_doc_string):
* doc.c (get_doc_string):
* doc.c (get_object_file_name):
* doc.c (Fdocumentation):
* doc.c (Fsnarf_documentation):
* doc.c (Fsubstitute_command_keys):
* editfns.c (init_editfns):
* editfns.c (Ftemp_directory):
* editfns.c (Fuser_login_name):
* editfns.c (Fuser_real_login_name):
* editfns.c (Fuser_home_directory):
* editfns.c (Fformat_time_string):
* editfns.c (Fcurrent_time_string):
* editfns.c (Fcurrent_time_zone):
* emacs.c:
* emacs.c (main_1):
* emodules.c (Flist_modules):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_sym):
* emodules.c (vars_of_module):
* event-Xt.c (x_has_keysym):
* event-gtk.c (emacs_gtk_format_magic_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (gtk_reset_key_mapping):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* faces.c (complex_vars_of_faces):
* file-coding.c (find_coding_system):
* file-coding.c (setup_eol_coding_systems):
* file-coding.c (make_coding_system_1):
* file-coding.c (snarf_coding_system):
* fileio.c:
* fileio.c (lisp_strerror):
* fileio.c (Ffile_name_directory):
* fileio.c (Ffile_name_as_directory):
* fileio.c (Fdirectory_file_name):
* fileio.c (if):
* fileio.c (Ffile_symlink_p):
* fileio.c (Fencrypt_string):
* fileio.c (Fdecrypt_string):
* filelock.c (lock_file):
* filelock.c (Ffile_locked_p):
* floatfns.c (matherr):
* font-mgr.c (build_fcapi_string):
* font-mgr.c (make_xlfd_font_regexp):
* frame-msw.c (mswindows_window_id):
* frame-msw.c (mswindows_frame_property):
* frame-x.c:
* frame-x.c (color_to_string):
* frame-x.c (maybe_set_frame_title_format):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (Fx_window_id):
* glade.c (connector):
* glade.c (Fglade_xml_textdomain):
* glade.c (syms_of_glade):
* glyphs-eimage.c (jpeg_instantiate):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (font_instantiate):
* glyphs-gtk.c (BUILD_GLYPH_INST):
* glyphs-x.c (x_locate_pixmap_file):
* glyphs-x.c (font_instantiate):
* glyphs-x.c (x_widget_property):
* glyphs-x.c (BUILD_GLYPH_INST):
* glyphs.c (print_image_instance):
* glyphs.c (bitmap_to_lisp_data):
* glyphs.c (pixmap_to_lisp_data):
* gpmevent.c (turn_off_gpm):
* gpmevent.c (Fgpm_enabled_p):
* gpmevent.c (Fgpm_enable):
* gtk-glue.c (__make_string_mapper):
* gtk-glue.c (xemacs_gtklist_to_list):
* gtk-xemacs.c (FROB_FACE):
* gtk-xemacs.c (xemacs_gtk_convert_color):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* insdel.c (buffer_insert_ascstring_1):
* insdel.h:
* insdel.h (buffer_insert_ascstring):
* intl.c (Fcurrent_locale):
* intl.c (Fset_current_locale):
* keymap.c (make_key_description):
* keymap.c (Ftext_char_description):
* keymap.c (describe_command):
* keymap.c (describe_map):
* lisp.h:
* lread.c:
* lread.c (locate_file_in_directory_mapper):
* lread.c (locate_file_construct_suffixed_files_mapper):
* mule-charset.c (Fmake_charset):
* nt.c (Fmswindows_short_file_name):
* nt.c (Fmswindows_long_file_name):
* objects-gtk.c (__get_gtk_font_truename):
* objects-gtk.c (__gtk_font_list_internal):
* objects-msw.c (font_enum_callback_2):
* objects-msw.c (create_hfont_from_font_spec):
* objects-msw.c (mswindows_font_list):
* objects-msw.c (mswindows_font_spec_matches_charset_stage_2):
* objects-tty.c (tty_initialize_font_instance):
* objects-x.c (x_font_truename):
* objects-x.c (x_font_instance_truename):
* objects-x.c (x_font_instance_properties):
* objects-x.c (x_font_list):
* print.c (write_cistring):
* print.c (print_vector_internal):
* print.c (print_cons):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_create_process):
* process-unix.c (unix_canonicalize_host_name):
* process.c (status_message):
* process.c (status_notify):
* process.c (init_xemacs_process):
* process.c (syms_of_process):
* redisplay-tty.c (term_get_fkeys_1):
* redisplay-tty.c (CONDITIONAL_REASSIGN):
* search.c (compile_pattern_1):
* select-common.h (selection_data_to_lisp_data):
* select-gtk.c (atom_to_symbol):
* select-gtk.c (PROCESSING_GTK_CODE):
* select-msw.c (mswindows_get_foreign_selection):
* select-x.c (x_atom_to_symbol):
* select-x.c (Fx_get_cutbuffer_internal):
* symbols.c (intern_istring):
* symbols.c (intern):
* symbols.c (intern_converting_underscores_to_dashes):
* symbols.c (Fintern):
* sysdep.c (init_system_name):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* syswindows.h:
* syswindows.h (build_tstr_string):
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (DFC_RESULT_PASS):
* tests.c (Ftest_data_format_conversion):
* text.c:
* text.c (new_dfc_convert_now_damn_it):
* text.h:
* text.h (build_wext_string):
* tooltalk.c (tt_build_c_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* ui-byhand.c (Fgtk_clist_get_text):
* ui-byhand.c (Fgtk_clist_get_pixtext):
* ui-byhand.c (Fgtk_label_get):
* ui-byhand.c (Fgtk_notebook_query_tab_label_packing):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* ui-gtk.c (gtk_type_to_lisp):
* ui-gtk.c (symbol_to_enum):
* ui-gtk.c (enum_to_symbol):
* unexaix.c (report_error):
* unexaix.c (ERROR0):
* unexec.c (report_error):
* unexec.c (ERROR0):
* unicode.c (unicode_to_ichar):
* win32.c (tstr_to_local_file_format):
* win32.c (Fmswindows_cygwin_to_win32_path):
* win32.c (struct read_link_hash):
* xemacs.def.in.in:
Rename:
write_c_string -> write_cistring
build_intstring -> build_istring
build_string -> build_cistring
build_ext_string -> build_extstring
make_ext_string -> make_extstring
buffer_insert_c_string -> buffer_insert_ascstring
intern_int -> intern_istring
These functions have been renamed so that the naming harmonizes
with the typedefs for strings: `cistring' along with CIbyte *,
`istring' along with Ibyte *, `extstring' along with Extbyte *,
`ascstring' along with Ascbyte *.
Also make buffer_insert_ascstring take Ascbyte * and assert
that its argument is ASCII.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Wed, 27 Jan 2010 00:35:36 -0600 |
parents | 2b1e7cb9ae2c |
children | 16112448d484 4aebb0131297 |
rev | line source |
---|---|
428 | 1 /* X Selection processing for XEmacs |
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. | |
793 | 3 Copyright (C) 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 | |
24 /* Rewritten by jwz */ | |
25 | |
26 #include <config.h> | |
27 #include "lisp.h" | |
28 | |
771 | 29 #include "charset.h" |
872 | 30 #include "device-impl.h" |
31 #include "frame-impl.h" | |
800 | 32 #include "opaque.h" |
33 #include "select.h" | |
34 | |
872 | 35 #include "console-x-impl.h" |
428 | 36 #include "objects-x.h" |
37 | |
38 #include "systime.h" | |
39 | |
40 int lisp_to_time (Lisp_Object, time_t *); | |
41 Lisp_Object time_to_lisp (time_t); | |
42 | |
43 #ifdef LWLIB_USES_MOTIF | |
44 # define MOTIF_CLIPBOARDS | |
45 #endif | |
46 | |
47 #ifdef MOTIF_CLIPBOARDS | |
1315 | 48 # include "xmotif.h" |
49 /* Kludge around shadowing warnings */ | |
50 # define index index_ | |
428 | 51 # include <Xm/CutPaste.h> |
1315 | 52 # undef index |
428 | 53 static void hack_motif_clipboard_selection (Atom selection_atom, |
54 Lisp_Object selection_value, | |
55 Time thyme, Display *display, | |
456 | 56 Window selecting_window, |
57 int owned_p); | |
428 | 58 #endif |
59 | |
60 #define CUT_BUFFER_SUPPORT | |
61 | |
62 #ifdef CUT_BUFFER_SUPPORT | |
63 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, | |
64 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; | |
65 #endif | |
66 | |
67 Lisp_Object Vx_sent_selection_hooks; | |
68 | |
69 /* If this is a smaller number than the max-request-size of the display, | |
70 emacs will use INCR selection transfer when the selection is larger | |
71 than this. The max-request-size is usually around 64k, so if you want | |
72 emacs to use incremental selection transfers when the selection is | |
73 smaller than that, set this. I added this mostly for debugging the | |
74 incremental transfer stuff, but it might improve server performance. | |
75 */ | |
76 #define MAX_SELECTION_QUANTUM 0xFFFFFF | |
77 | |
78 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100) | |
79 | |
80 /* If the selection owner takes too long to reply to a selection request, | |
81 we give up on it. This is in seconds (0 = no timeout). | |
82 */ | |
458 | 83 Fixnum x_selection_timeout; |
428 | 84 |
456 | 85 /* Enable motif selection optimizations. */ |
86 int x_selection_strict_motif_ownership; | |
87 | |
428 | 88 |
89 /* Utility functions */ | |
90 | |
91 static Lisp_Object x_get_window_property_as_lisp_data (Display *, | |
92 Window, | |
93 Atom property, | |
94 Lisp_Object target_type, | |
95 Atom selection_atom); | |
96 | |
97 static int expect_property_change (Display *, Window, Atom prop, int state); | |
98 static void wait_for_property_change (long); | |
99 static void unexpect_property_change (int); | |
100 static int waiting_for_other_props_on_window (Display *, Window); | |
101 | |
102 /* This converts a Lisp symbol to a server Atom, avoiding a server | |
103 roundtrip whenever possible. | |
104 */ | |
105 static Atom | |
106 symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists) | |
107 { | |
108 Display *display = DEVICE_X_DISPLAY (d); | |
109 | |
110 if (NILP (sym)) return XA_PRIMARY; | |
111 if (EQ (sym, Qt)) return XA_SECONDARY; | |
112 if (EQ (sym, QPRIMARY)) return XA_PRIMARY; | |
113 if (EQ (sym, QSECONDARY)) return XA_SECONDARY; | |
114 if (EQ (sym, QSTRING)) return XA_STRING; | |
115 if (EQ (sym, QINTEGER)) return XA_INTEGER; | |
116 if (EQ (sym, QATOM)) return XA_ATOM; | |
117 if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d); | |
118 if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d); | |
119 if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d); | |
120 if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d); | |
121 if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d); | |
122 if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d); | |
123 if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d); | |
124 if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d); | |
125 if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d); | |
126 if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d); | |
127 if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d); | |
128 | |
129 #ifdef CUT_BUFFER_SUPPORT | |
130 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0; | |
131 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1; | |
132 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2; | |
133 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3; | |
134 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4; | |
135 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5; | |
136 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6; | |
137 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7; | |
138 #endif /* CUT_BUFFER_SUPPORT */ | |
139 | |
140 { | |
647 | 141 const Extbyte *nameext; |
442 | 142 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext); |
428 | 143 return XInternAtom (display, nameext, only_if_exists ? True : False); |
144 } | |
145 } | |
146 | |
147 | |
148 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips | |
149 and calls to intern whenever possible. | |
150 */ | |
151 static Lisp_Object | |
152 x_atom_to_symbol (struct device *d, Atom atom) | |
153 { | |
154 Display *display = DEVICE_X_DISPLAY (d); | |
155 | |
156 if (! atom) return Qnil; | |
157 if (atom == XA_PRIMARY) return QPRIMARY; | |
158 if (atom == XA_SECONDARY) return QSECONDARY; | |
159 if (atom == XA_STRING) return QSTRING; | |
160 if (atom == XA_INTEGER) return QINTEGER; | |
161 if (atom == XA_ATOM) return QATOM; | |
162 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD; | |
163 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP; | |
164 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT; | |
165 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE; | |
166 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE; | |
167 if (atom == DEVICE_XATOM_INCR (d)) return QINCR; | |
168 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP; | |
169 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS; | |
170 if (atom == DEVICE_XATOM_NULL (d)) return QNULL; | |
171 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR; | |
172 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT; | |
173 | |
174 #ifdef CUT_BUFFER_SUPPORT | |
175 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0; | |
176 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1; | |
177 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2; | |
178 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3; | |
179 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4; | |
180 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5; | |
181 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6; | |
182 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7; | |
183 #endif | |
184 | |
185 { | |
867 | 186 Ibyte *intstr; |
771 | 187 Extbyte *str = XGetAtomName (display, atom); |
428 | 188 |
189 if (! str) return Qnil; | |
190 | |
440 | 191 TO_INTERNAL_FORMAT (C_STRING, str, |
192 C_STRING_ALLOCA, intstr, | |
193 Qctext); | |
428 | 194 XFree (str); |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3833
diff
changeset
|
195 return intern_istring (intstr); |
428 | 196 } |
197 } | |
198 | |
647 | 199 #define PROCESSING_X_CODE |
200 #include "select-common.h" | |
201 #undef PROCESSING_X_CODE | |
428 | 202 |
203 /* Do protocol to assert ourself as a selection owner. | |
204 */ | |
205 static Lisp_Object | |
2286 | 206 x_own_selection (Lisp_Object selection_name, |
207 #ifdef MOTIF_CLIPBOARDS | |
208 Lisp_Object selection_value, | |
209 #else | |
210 Lisp_Object UNUSED (selection_value), | |
211 #endif | |
212 Lisp_Object UNUSED (how_to_add), | |
213 Lisp_Object UNUSED (selection_type), | |
214 #ifdef MOTIF_CLIPBOARDS | |
215 int owned_p | |
216 #else | |
217 int UNUSED (owned_p) | |
218 #endif | |
219 ) | |
428 | 220 { |
221 struct device *d = decode_x_device (Qnil); | |
222 Display *display = DEVICE_X_DISPLAY (d); | |
223 struct frame *sel_frame = selected_frame (); | |
224 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); | |
225 Lisp_Object selection_time; | |
226 /* Use the time of the last-read mouse or keyboard event. | |
227 For selection purposes, we use this as a sleazy way of knowing what the | |
228 current time is in server-time. This assumes that the most recently read | |
229 mouse or keyboard event has something to do with the assertion of the | |
230 selection, which is probably true. | |
231 */ | |
232 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d); | |
233 Atom selection_atom; | |
234 | |
235 CHECK_SYMBOL (selection_name); | |
236 selection_atom = symbol_to_x_atom (d, selection_name, 0); | |
237 | |
238 XSetSelectionOwner (display, selection_atom, selecting_window, thyme); | |
239 | |
2620 | 240 /* [[ We do NOT use time_to_lisp() here any more, like we used to. |
428 | 241 That assumed equivalence of time_t and Time, which is not |
242 necessarily the case (e.g. under OSF on the Alphas, where | |
2620 | 243 Time is a 64-bit quantity and time_t is a 32-bit quantity).]] |
244 | |
245 This is wrong--on Digital Unix, time_t is a sixty-four-bit quantity, | |
246 and Time is, as the X protocol dictates, a thirty-two-bit quantity. | |
442 | 247 |
2620 | 248 [[ Opaque pointers are the clean way to go here. ]] |
249 | |
250 Again, I disagree--the Lisp selection infrastructure needs to be | |
251 able to manipulate the selection timestamps if it is, as we want | |
252 it to, to be able to do most of the work. Though I have moved the | |
253 conversion to lisp to get-xemacs-selection-timestamp. -- Aidan. */ | |
254 | |
440 | 255 selection_time = make_opaque (&thyme, sizeof (thyme)); |
428 | 256 |
257 #ifdef MOTIF_CLIPBOARDS | |
258 hack_motif_clipboard_selection (selection_atom, selection_value, | |
456 | 259 thyme, display, selecting_window, owned_p); |
428 | 260 #endif |
261 return selection_time; | |
262 } | |
263 | |
264 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */ | |
265 | |
266 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
267 static void motif_clipboard_cb (); | |
268 # endif | |
269 | |
270 static void | |
271 hack_motif_clipboard_selection (Atom selection_atom, | |
272 Lisp_Object selection_value, | |
273 Time thyme, | |
274 Display *display, | |
456 | 275 Window selecting_window, |
276 int owned_p) | |
428 | 277 { |
278 struct device *d = get_device_from_display (display); | |
279 /* Those Motif wankers can't be bothered to follow the ICCCM, and do | |
280 their own non-Xlib non-Xt clipboard processing. So we have to do | |
281 this so that linked-in Motif widgets don't get themselves wedged. | |
282 */ | |
283 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d) | |
284 && STRINGP (selection_value) | |
285 | |
286 /* If we already own the clipboard, don't own it again in the Motif | |
287 way. This might lose in some subtle way, since the timestamp won't | |
288 be current, but owning the selection on the Motif way does a | |
289 SHITLOAD of X protocol, and it makes killing text be incredibly | |
290 slow when using an X terminal. ARRRRGGGHHH!!!! | |
291 */ | |
292 /* No, this is no good, because then Motif text fields don't bother | |
293 to look up the new value, and you can't Copy from a buffer, Paste | |
294 into a text field, then Copy something else from the buffer and | |
295 paste it into the text field -- it pastes the first thing again. */ | |
456 | 296 && (!owned_p |
297 /* Selectively re-enable this because for most users its | |
298 just too painful - especially over a remote link. */ | |
299 || x_selection_strict_motif_ownership) | |
428 | 300 ) |
301 { | |
302 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
303 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame()); | |
304 #endif | |
305 long itemid; | |
306 #if XmVersion >= 1002 | |
307 long dataid; | |
308 #else | |
309 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */ | |
310 #endif | |
311 XmString fmh; | |
312 String encoding = "STRING"; | |
867 | 313 const Ibyte *data = XSTRING_DATA (selection_value); |
444 | 314 Bytecount bytes = XSTRING_LENGTH (selection_value); |
428 | 315 |
316 #ifdef MULE | |
317 { | |
318 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; | |
867 | 319 const Ibyte *ptr = data, *end = ptr + bytes; |
428 | 320 /* Optimize for the common ASCII case */ |
321 while (ptr <= end) | |
322 { | |
826 | 323 if (byte_ascii_p (*ptr)) |
428 | 324 { |
325 ptr++; | |
326 continue; | |
327 } | |
328 | |
329 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || | |
330 (*ptr) == LEADING_BYTE_CONTROL_1) | |
331 { | |
332 chartypes = LATIN_1; | |
333 ptr += 2; | |
334 continue; | |
335 } | |
336 | |
337 chartypes = WORLD; | |
338 break; | |
339 } | |
340 | |
341 if (chartypes == LATIN_1) | |
440 | 342 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value, |
343 ALLOCA, (data, bytes), | |
344 Qbinary); | |
428 | 345 else if (chartypes == WORLD) |
346 { | |
440 | 347 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value, |
348 ALLOCA, (data, bytes), | |
349 Qctext); | |
428 | 350 encoding = "COMPOUND_TEXT"; |
351 } | |
352 } | |
353 #endif /* MULE */ | |
354 | |
355 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET); | |
356 while (ClipboardSuccess != | |
357 XmClipboardStartCopy (display, selecting_window, fmh, thyme, | |
358 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
359 widget, motif_clipboard_cb, | |
360 #else | |
361 0, NULL, | |
362 #endif | |
363 &itemid)) | |
364 ; | |
365 XmStringFree (fmh); | |
366 while (ClipboardSuccess != | |
367 XmClipboardCopy (display, selecting_window, itemid, encoding, | |
368 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
369 /* O'Reilly examples say size can be 0, | |
370 but this clearly is not the case. */ | |
371 0, bytes, (int) selecting_window, /* private id */ | |
372 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ | |
373 (XtPointer) data, bytes, 0, | |
374 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ | |
375 &dataid)) | |
376 ; | |
377 while (ClipboardSuccess != | |
378 XmClipboardEndCopy (display, selecting_window, itemid)) | |
379 ; | |
380 } | |
381 } | |
382 | |
383 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
384 /* I tried to treat the clipboard like a real selection, and not send | |
385 the data until it was requested, but it looks like that just doesn't | |
386 work at all unless the selection owner and requestor are in different | |
387 processes. From reading the Motif source, it looks like they never | |
388 even considered having two widgets in the same application transfer | |
389 data between each other using "by-name" clipboard values. What a | |
390 bunch of fuckups. | |
391 */ | |
392 static void | |
393 motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason) | |
394 { | |
395 switch (*reason) | |
396 { | |
397 case XmCR_CLIPBOARD_DATA_REQUEST: | |
398 { | |
399 Display *dpy = XtDisplay (widget); | |
400 Window window = (Window) *private_id; | |
442 | 401 Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil); |
402 | |
2500 | 403 /* Whichever lazy git wrote this originally just called ABORT() |
442 | 404 when anything didn't go their way... */ |
405 | |
406 /* Try some other text types */ | |
407 if (NILP (selection)) | |
408 selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil); | |
409 if (NILP (selection)) | |
410 selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil); | |
411 if (NILP (selection)) | |
412 selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil); | |
413 | |
414 if (CONSP (selection) && SYMBOLP (XCAR (selection)) | |
415 && (EQ (XCAR (selection), QSTRING) | |
416 || EQ (XCAR (selection), QTEXT) | |
417 || EQ (XCAR (selection), QCOMPOUND_TEXT))) | |
418 selection = XCDR (selection); | |
419 | |
420 if (NILP (selection)) | |
563 | 421 signal_error (Qselection_conversion_error, "no selection", |
422 Qunbound); | |
442 | 423 |
424 if (!STRINGP (selection)) | |
425 signal_error (Qselection_conversion_error, | |
563 | 426 "couldn't convert selection to string", Qunbound); |
442 | 427 |
428 | |
428 | 429 XmClipboardCopyByName (dpy, window, *data_id, |
430 (char *) XSTRING_DATA (selection), | |
431 XSTRING_LENGTH (selection) + 1, | |
432 0); | |
433 } | |
434 break; | |
435 case XmCR_CLIPBOARD_DATA_DELETE: | |
436 default: | |
437 /* don't need to free anything */ | |
438 break; | |
439 } | |
440 } | |
441 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ | |
442 #endif /* MOTIF_CLIPBOARDS */ | |
443 | |
444 | |
445 | |
446 | |
447 /* Send a SelectionNotify event to the requestor with property=None, meaning | |
448 we were unable to do what they wanted. | |
449 */ | |
450 static void | |
451 x_decline_selection_request (XSelectionRequestEvent *event) | |
452 { | |
453 XSelectionEvent reply; | |
454 reply.type = SelectionNotify; | |
455 reply.display = event->display; | |
456 reply.requestor = event->requestor; | |
457 reply.selection = event->selection; | |
458 reply.time = event->time; | |
459 reply.target = event->target; | |
460 reply.property = None; | |
461 | |
462 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply); | |
463 XFlush (reply.display); | |
464 } | |
465 | |
466 | |
467 /* Used as an unwind-protect clause so that, if a selection-converter signals | |
468 an error, we tell the requestor that we were unable to do what they wanted | |
469 before we throw to top-level or go into the debugger or whatever. | |
470 */ | |
471 static Lisp_Object | |
472 x_selection_request_lisp_error (Lisp_Object closure) | |
473 { | |
474 XSelectionRequestEvent *event = (XSelectionRequestEvent *) | |
475 get_opaque_ptr (closure); | |
476 | |
477 free_opaque_ptr (closure); | |
478 if (event->type == 0) /* we set this to mean "completed normally" */ | |
479 return Qnil; | |
480 x_decline_selection_request (event); | |
481 return Qnil; | |
482 } | |
483 | |
484 | |
485 /* Convert our selection to the requested type, and put that data where the | |
486 requestor wants it. Then tell them whether we've succeeded. | |
487 */ | |
488 static void | |
489 x_reply_selection_request (XSelectionRequestEvent *event, int format, | |
2367 | 490 Rawbyte *data, Bytecount size, Atom type) |
428 | 491 { |
492 /* This function can GC */ | |
493 XSelectionEvent reply; | |
494 Display *display = event->display; | |
495 struct device *d = get_device_from_display (display); | |
496 Window window = event->requestor; | |
665 | 497 Bytecount bytes_remaining; |
428 | 498 int format_bytes = format/8; |
665 | 499 Bytecount max_bytes = SELECTION_QUANTUM (display); |
428 | 500 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM; |
501 | |
502 reply.type = SelectionNotify; | |
503 reply.display = display; | |
504 reply.requestor = window; | |
505 reply.selection = event->selection; | |
506 reply.time = event->time; | |
507 reply.target = event->target; | |
508 reply.property = (event->property == None ? event->target : event->property); | |
509 | |
510 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */ | |
511 | |
512 /* Store the data on the requested property. | |
513 If the selection is large, only store the first N bytes of it. | |
514 */ | |
515 bytes_remaining = size * format_bytes; | |
516 if (bytes_remaining <= max_bytes) | |
517 { | |
518 /* Send all the data at once, with minimal handshaking. */ | |
519 #if 0 | |
520 stderr_out ("\nStoring all %d\n", bytes_remaining); | |
521 #endif | |
522 XChangeProperty (display, window, reply.property, type, format, | |
523 PropModeReplace, data, size); | |
524 /* At this point, the selection was successfully stored; ack it. */ | |
525 XSendEvent (display, window, False, 0L, (XEvent *) &reply); | |
526 XFlush (display); | |
527 } | |
528 else | |
529 { | |
2625 | 530 #ifndef HAVE_XTREGISTERDRAWABLE |
2627 | 531 invalid_operation("Copying that much data requires X11R6.", Qunbound); |
2625 | 532 #else |
428 | 533 /* Send an INCR selection. */ |
534 int prop_id; | |
2623 | 535 Widget widget = FRAME_X_TEXT_WIDGET (XFRAME(DEVICE_SELECTED_FRAME(d))); |
428 | 536 |
537 if (x_window_to_frame (d, window)) /* #### debug */ | |
2619 | 538 invalid_operation ("attempt to transfer an INCR to ourself!", |
539 Qunbound); | |
428 | 540 #if 0 |
541 stderr_out ("\nINCR %d\n", bytes_remaining); | |
542 #endif | |
2619 | 543 |
544 /* Tell Xt not to drop PropertyNotify events that arrive for the | |
545 target window, rather, pass them to us. This would be a hack, but | |
546 the Xt selection routines are broken for our purposes--we can't | |
547 pass them callbacks from Lisp, for example. Let's call it a | |
2629 | 548 workaround. |
549 | |
550 The call to wait_for_property_change means we can break out of that | |
551 function, switch to another frame on the same display (which will | |
552 be another Xt widget), select a huge amount of text, and have the | |
553 same (foreign) app ask for another incremental selection | |
554 transfer. Programming like X11 made sense, would mean that, in that | |
555 case, XtRegisterDrawable is called twice with different widgets. | |
556 | |
557 Since the results of calling XtRegisterDrawable when the drawable | |
558 is already registered with another widget are undefined, we want to | |
559 avoid that--so, only call it when XtWindowToWidget returns NULL, | |
560 which it will only do with a valid Window if it's not already | |
561 registered. */ | |
562 if (NULL == XtWindowToWidget(display, window)) | |
563 { | |
564 XtRegisterDrawable(display, (Drawable)window, widget); | |
565 } | |
2619 | 566 |
428 | 567 prop_id = expect_property_change (display, window, reply.property, |
568 PropertyDelete); | |
569 | |
570 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d), | |
2367 | 571 32, PropModeReplace, (Rawbyte *) |
428 | 572 &bytes_remaining, 1); |
573 XSelectInput (display, window, PropertyChangeMask); | |
574 /* Tell 'em the INCR data is there... */ | |
575 XSendEvent (display, window, False, 0L, (XEvent *) &reply); | |
576 XFlush (display); | |
577 | |
578 /* First, wait for the requestor to ack by deleting the property. | |
579 This can run random lisp code (process handlers) or signal. | |
580 */ | |
581 wait_for_property_change (prop_id); | |
582 | |
583 while (bytes_remaining) | |
584 { | |
665 | 585 Bytecount i = ((bytes_remaining < max_bytes) |
428 | 586 ? bytes_remaining |
587 : max_bytes); | |
588 prop_id = expect_property_change (display, window, reply.property, | |
589 PropertyDelete); | |
590 #if 0 | |
591 stderr_out (" INCR adding %d\n", i); | |
592 #endif | |
593 /* Append the next chunk of data to the property. */ | |
594 XChangeProperty (display, window, reply.property, type, format, | |
595 PropModeAppend, data, i / format_bytes); | |
596 bytes_remaining -= i; | |
597 data += i; | |
598 | |
599 /* Now wait for the requestor to ack this chunk by deleting the | |
600 property. This can run random lisp code or signal. | |
601 */ | |
602 wait_for_property_change (prop_id); | |
603 } | |
604 /* Now write a zero-length chunk to the property to tell the requestor | |
605 that we're done. */ | |
606 #if 0 | |
607 stderr_out (" INCR done\n"); | |
608 #endif | |
609 if (! waiting_for_other_props_on_window (display, window)) | |
2619 | 610 { |
428 | 611 XSelectInput (display, window, 0L); |
2619 | 612 XtUnregisterDrawable(display, (Drawable)window); |
613 } | |
428 | 614 XChangeProperty (display, window, reply.property, type, format, |
615 PropModeReplace, data, 0); | |
2625 | 616 #endif /* HAVE_XTREGISTERDRAWABLE */ |
428 | 617 } |
618 } | |
619 | |
620 | |
621 | |
622 /* Called from the event-loop in response to a SelectionRequest event. | |
623 */ | |
624 void | |
625 x_handle_selection_request (XSelectionRequestEvent *event) | |
626 { | |
627 /* This function can GC */ | |
442 | 628 struct gcpro gcpro1, gcpro2; |
629 Lisp_Object temp_obj; | |
428 | 630 Lisp_Object selection_symbol; |
631 Lisp_Object target_symbol = Qnil; | |
632 Lisp_Object converted_selection = Qnil; | |
633 Time local_selection_time; | |
634 Lisp_Object successful_p = Qnil; | |
635 int count; | |
636 struct device *d = get_device_from_display (event->display); | |
637 | |
442 | 638 GCPRO2 (converted_selection, target_symbol); |
428 | 639 |
640 selection_symbol = x_atom_to_symbol (d, event->selection); | |
442 | 641 target_symbol = x_atom_to_symbol (d, event->target); |
428 | 642 |
442 | 643 #if 0 /* #### MULTIPLE doesn't work yet */ |
644 if (EQ (target_symbol, QMULTIPLE)) | |
645 target_symbol = fetch_multiple_target (event); | |
428 | 646 #endif |
647 | |
2620 | 648 temp_obj = get_selection_raw_time (selection_symbol); |
442 | 649 |
650 if (NILP (temp_obj)) | |
428 | 651 { |
442 | 652 /* We don't appear to have the selection. */ |
428 | 653 x_decline_selection_request (event); |
442 | 654 |
428 | 655 goto DONE_LABEL; |
656 } | |
657 | |
442 | 658 local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj); |
428 | 659 |
660 if (event->time != CurrentTime && | |
661 local_selection_time > event->time) | |
662 { | |
663 /* Someone asked for the selection, and we have one, but not the one | |
664 they're looking for. */ | |
665 x_decline_selection_request (event); | |
666 goto DONE_LABEL; | |
667 } | |
668 | |
442 | 669 converted_selection = select_convert_out (selection_symbol, |
670 target_symbol, Qnil); | |
671 | |
672 /* #### Is this the right thing to do? I'm no X expert. -- ajh */ | |
673 if (NILP (converted_selection)) | |
674 { | |
675 /* We don't appear to have a selection in that data type. */ | |
676 x_decline_selection_request (event); | |
677 goto DONE_LABEL; | |
678 } | |
679 | |
428 | 680 count = specpdl_depth (); |
681 record_unwind_protect (x_selection_request_lisp_error, | |
682 make_opaque_ptr (event)); | |
683 | |
442 | 684 { |
2367 | 685 Rawbyte *data; |
665 | 686 Bytecount size; |
442 | 687 int format; |
688 Atom type; | |
689 lisp_data_to_selection_data (d, converted_selection, | |
690 &data, &type, &size, &format); | |
428 | 691 |
442 | 692 x_reply_selection_request (event, format, data, size, type); |
693 successful_p = Qt; | |
694 /* Tell x_selection_request_lisp_error() it's cool. */ | |
695 event->type = 0; | |
2620 | 696 /* Data need not have been allocated; cf. select-convert-to-delete in |
697 lisp/select.el . */ | |
698 if ((Rawbyte *)0 != data) | |
699 { | |
700 xfree (data, Rawbyte *); | |
701 } | |
442 | 702 } |
703 | |
771 | 704 unbind_to (count); |
428 | 705 |
706 DONE_LABEL: | |
707 | |
708 UNGCPRO; | |
709 | |
710 /* Let random lisp code notice that the selection has been asked for. */ | |
711 { | |
712 Lisp_Object val = Vx_sent_selection_hooks; | |
713 if (!UNBOUNDP (val) && !NILP (val)) | |
714 { | |
442 | 715 Lisp_Object rest; |
428 | 716 if (CONSP (val) && !EQ (XCAR (val), Qlambda)) |
717 for (rest = val; !NILP (rest); rest = Fcdr (rest)) | |
442 | 718 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p); |
428 | 719 else |
442 | 720 call3 (val, selection_symbol, target_symbol, successful_p); |
428 | 721 } |
722 } | |
723 } | |
724 | |
725 | |
726 /* Called from the event-loop in response to a SelectionClear event. | |
727 */ | |
728 void | |
729 x_handle_selection_clear (XSelectionClearEvent *event) | |
730 { | |
731 Display *display = event->display; | |
732 struct device *d = get_device_from_display (display); | |
733 Atom selection = event->selection; | |
734 Time changed_owner_time = event->time; | |
735 | |
442 | 736 Lisp_Object selection_symbol, local_selection_time_lisp; |
428 | 737 Time local_selection_time; |
738 | |
739 selection_symbol = x_atom_to_symbol (d, selection); | |
740 | |
2620 | 741 local_selection_time_lisp = get_selection_raw_time (selection_symbol); |
428 | 742 |
442 | 743 /* We don't own the selection, so that's fine. */ |
744 if (NILP (local_selection_time_lisp)) | |
745 return; | |
428 | 746 |
442 | 747 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp); |
428 | 748 |
749 /* This SelectionClear is for a selection that we no longer own, so we can | |
750 disregard it. (That is, we have reasserted the selection since this | |
751 request was generated.) | |
752 */ | |
753 if (changed_owner_time != CurrentTime && | |
754 local_selection_time > changed_owner_time) | |
755 return; | |
442 | 756 |
428 | 757 handle_selection_clear (selection_symbol); |
758 } | |
759 | |
760 | |
761 /* This stuff is so that INCR selections are reentrant (that is, so we can | |
762 be servicing multiple INCR selection requests simultaneously). I haven't | |
763 actually tested that yet. | |
764 */ | |
765 | |
766 static int prop_location_tick; | |
767 | |
768 static struct prop_location { | |
769 int tick; | |
770 Display *display; | |
771 Window window; | |
772 Atom property; | |
773 int desired_state; | |
774 struct prop_location *next; | |
775 } *for_whom_the_bell_tolls; | |
776 | |
777 | |
778 static int | |
779 property_deleted_p (void *tick) | |
780 { | |
781 struct prop_location *rest = for_whom_the_bell_tolls; | |
782 while (rest) | |
783 if (rest->tick == (long) tick) | |
784 return 0; | |
785 else | |
786 rest = rest->next; | |
787 return 1; | |
788 } | |
789 | |
790 static int | |
791 waiting_for_other_props_on_window (Display *display, Window window) | |
792 { | |
793 struct prop_location *rest = for_whom_the_bell_tolls; | |
794 while (rest) | |
795 if (rest->display == display && rest->window == window) | |
796 return 1; | |
797 else | |
798 rest = rest->next; | |
799 return 0; | |
800 } | |
801 | |
802 | |
803 static int | |
804 expect_property_change (Display *display, Window window, | |
805 Atom property, int state) | |
806 { | |
807 struct prop_location *pl = xnew (struct prop_location); | |
808 pl->tick = ++prop_location_tick; | |
809 pl->display = display; | |
810 pl->window = window; | |
811 pl->property = property; | |
812 pl->desired_state = state; | |
813 pl->next = for_whom_the_bell_tolls; | |
814 for_whom_the_bell_tolls = pl; | |
815 return pl->tick; | |
816 } | |
817 | |
818 static void | |
819 unexpect_property_change (int tick) | |
820 { | |
821 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; | |
822 while (rest) | |
823 { | |
824 if (rest->tick == tick) | |
825 { | |
826 if (prev) | |
827 prev->next = rest->next; | |
828 else | |
829 for_whom_the_bell_tolls = rest->next; | |
1726 | 830 xfree (rest, struct prop_location *); |
428 | 831 return; |
832 } | |
833 prev = rest; | |
834 rest = rest->next; | |
835 } | |
836 } | |
837 | |
838 static void | |
839 wait_for_property_change (long tick) | |
840 { | |
841 /* This function can GC */ | |
842 wait_delaying_user_input (property_deleted_p, (void *) tick); | |
843 } | |
844 | |
845 | |
846 /* Called from the event-loop in response to a PropertyNotify event. | |
847 */ | |
848 void | |
849 x_handle_property_notify (XPropertyEvent *event) | |
850 { | |
851 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; | |
852 while (rest) | |
853 { | |
854 if (rest->property == event->atom && | |
855 rest->window == event->window && | |
856 rest->display == event->display && | |
857 rest->desired_state == event->state) | |
858 { | |
859 #if 0 | |
860 stderr_out ("Saw expected prop-%s on %s\n", | |
793 | 861 (event->state == PropertyDelete ? "delete" : "change"), |
862 XSTRING_DATA | |
863 (XSYMBOL (x_atom_to_symbol | |
864 (get_device_from_display (event->display), | |
1726 | 865 event->atom))->name)); |
428 | 866 #endif |
867 if (prev) | |
868 prev->next = rest->next; | |
869 else | |
870 for_whom_the_bell_tolls = rest->next; | |
1726 | 871 xfree (rest, struct prop_location *); |
428 | 872 return; |
873 } | |
874 prev = rest; | |
875 rest = rest->next; | |
876 } | |
877 #if 0 | |
878 stderr_out ("Saw UNexpected prop-%s on %s\n", | |
793 | 879 (event->state == PropertyDelete ? "delete" : "change"), |
880 XSTRING_DATA (XSYMBOL (x_atom_to_symbol | |
881 (get_device_from_display (event->display), | |
882 event->atom))->name)); | |
428 | 883 #endif |
884 } | |
885 | |
886 | |
887 | |
888 #if 0 /* #### MULTIPLE doesn't work yet */ | |
889 | |
890 static Lisp_Object | |
891 fetch_multiple_target (XSelectionRequestEvent *event) | |
892 { | |
893 /* This function can GC */ | |
894 Display *display = event->display; | |
895 Window window = event->requestor; | |
896 Atom target = event->target; | |
897 Atom selection_atom = event->selection; | |
898 int result; | |
899 | |
900 return | |
901 Fcons (QMULTIPLE, | |
902 x_get_window_property_as_lisp_data (display, window, target, | |
903 QMULTIPLE, | |
904 selection_atom)); | |
905 } | |
906 | |
907 static Lisp_Object | |
908 copy_multiple_data (Lisp_Object obj) | |
909 { | |
910 Lisp_Object vec; | |
665 | 911 Elemcount i; |
912 Elemcount len; | |
428 | 913 if (CONSP (obj)) |
914 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj))); | |
915 | |
916 CHECK_VECTOR (obj); | |
917 len = XVECTOR_LENGTH (obj); | |
918 vec = make_vector (len, Qnil); | |
919 for (i = 0; i < len; i++) | |
920 { | |
921 Lisp_Object vec2 = XVECTOR_DATA (obj) [i]; | |
922 CHECK_VECTOR (vec2); | |
923 if (XVECTOR_LENGTH (vec2) != 2) | |
563 | 924 sferror ("vectors must be of length 2", vec2); |
428 | 925 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil); |
926 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0]; | |
927 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1]; | |
928 } | |
929 return vec; | |
930 } | |
931 | |
932 #endif /* 0 */ | |
933 | |
934 | |
935 static Window reading_selection_reply; | |
936 static Atom reading_which_selection; | |
937 static int selection_reply_timed_out; | |
938 | |
939 static int | |
2286 | 940 selection_reply_done (void *UNUSED (unused)) |
428 | 941 { |
942 return !reading_selection_reply; | |
943 } | |
944 | |
945 static Lisp_Object Qx_selection_reply_timeout_internal; | |
946 | |
947 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal, | |
948 1, 1, 0, /* | |
949 */ | |
2286 | 950 (UNUSED (arg))) |
428 | 951 { |
952 selection_reply_timed_out = 1; | |
953 reading_selection_reply = 0; | |
954 return Qnil; | |
955 } | |
956 | |
957 | |
958 /* Do protocol to read selection-data from the server. | |
959 Converts this to lisp data and returns it. | |
960 */ | |
961 static Lisp_Object | |
962 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type) | |
963 { | |
964 /* This function can GC */ | |
965 struct device *d = decode_x_device (Qnil); | |
966 Display *display = DEVICE_X_DISPLAY (d); | |
967 struct frame *sel_frame = selected_frame (); | |
968 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); | |
969 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d); | |
970 Atom target_property = DEVICE_XATOM_EMACS_TMP (d); | |
971 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0); | |
972 int speccount; | |
973 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ? | |
974 XCAR (target_type) : target_type), 0); | |
975 | |
976 XConvertSelection (display, selection_atom, type_atom, target_property, | |
977 requestor_window, requestor_time); | |
978 | |
979 /* Block until the reply has been read. */ | |
980 reading_selection_reply = requestor_window; | |
981 reading_which_selection = selection_atom; | |
982 selection_reply_timed_out = 0; | |
983 | |
984 speccount = specpdl_depth (); | |
985 | |
986 /* add a timeout handler */ | |
987 if (x_selection_timeout > 0) | |
988 { | |
989 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout), | |
990 Qx_selection_reply_timeout_internal, | |
991 Qnil, Qnil); | |
992 record_unwind_protect (Fdisable_timeout, id); | |
993 } | |
994 | |
995 /* This is ^Gable */ | |
996 wait_delaying_user_input (selection_reply_done, 0); | |
997 | |
998 if (selection_reply_timed_out) | |
563 | 999 signal_error (Qselection_conversion_error, "timed out waiting for reply from selection owner", Qunbound); |
428 | 1000 |
771 | 1001 unbind_to (speccount); |
428 | 1002 |
1003 /* otherwise, the selection is waiting for us on the requested property. */ | |
442 | 1004 |
1005 return select_convert_in (selection_symbol, | |
1006 target_type, | |
1007 x_get_window_property_as_lisp_data(display, | |
1008 requestor_window, | |
1009 target_property, | |
1010 target_type, | |
1011 selection_atom)); | |
428 | 1012 } |
1013 | |
1014 | |
1015 static void | |
1016 x_get_window_property (Display *display, Window window, Atom property, | |
2367 | 1017 Rawbyte **data_ret, Bytecount *bytes_ret, |
428 | 1018 Atom *actual_type_ret, int *actual_format_ret, |
1019 unsigned long *actual_size_ret, int delete_p) | |
1020 { | |
665 | 1021 Bytecount total_size; |
428 | 1022 unsigned long bytes_remaining; |
665 | 1023 Bytecount offset = 0; |
2367 | 1024 Rawbyte *tmp_data = 0; |
428 | 1025 int result; |
665 | 1026 Bytecount buffer_size = SELECTION_QUANTUM (display); |
428 | 1027 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM; |
1028 | |
1029 /* First probe the thing to find out how big it is. */ | |
1030 result = XGetWindowProperty (display, window, property, | |
1031 0, 0, False, AnyPropertyType, | |
1032 actual_type_ret, actual_format_ret, | |
1033 actual_size_ret, | |
1034 &bytes_remaining, &tmp_data); | |
1035 if (result != Success) | |
1036 { | |
1037 *data_ret = 0; | |
1038 *bytes_ret = 0; | |
1039 return; | |
1040 } | |
1041 XFree ((char *) tmp_data); | |
1042 | |
1043 if (*actual_type_ret == None || *actual_format_ret == 0) | |
1044 { | |
1045 if (delete_p) XDeleteProperty (display, window, property); | |
1046 *data_ret = 0; | |
1047 *bytes_ret = 0; | |
1048 return; | |
1049 } | |
1050 | |
3833 | 1051 /* The manpage for XGetWindowProperty from X.org X11.7.2 sez: |
1052 nitems_return [[ our actual_size_ret ]] | |
1053 Returns the actual number of 8-bit, 16-bit, or 32-bit items | |
1054 stored in the prop_return data. | |
1055 prop_return [[ our tmp_data ]] | |
1056 Returns the data in the specified format. If the returned | |
1057 format is 8, the returned data is represented as a char | |
1058 array. If the returned format is 16, the returned data is | |
1059 represented as a array of short int type and should be cast | |
1060 to that type to obtain the elements. If the returned format | |
1061 is 32, the property data will be stored as an array of longs | |
1062 (which in a 64-bit application will be 64-bit values that are | |
1063 padded in the upper 4 bytes). | |
1064 bytes_after_return [[ our bytes_remaining ]] | |
1065 Returns the number of bytes remaining to be read in the prop- | |
1066 erty if a partial read was performed. | |
1067 | |
1068 AFAIK XEmacs does not support any platforms where the char type is other | |
1069 than 8 bits (Cray?), or where the short type is other than 16 bits. | |
1070 There is no such agreement on the size of long, and 64-bit platforms | |
1071 generally make long be a 64-bit quantity while while it's 32 bits on | |
1072 32-bit platforms. | |
1073 | |
1074 This means that on all platforms the wire item is the same size as our | |
1075 buffer unit when format == 8 or format == 16 or format == wordsize == 32, | |
1076 and the buffer size can be taken as bytes_remaining plus padding. | |
1077 However, when format == 32 and wordsize == 64, the buffer unit is twice | |
1078 the size of the wire item. Obviously this code below is not 128-bit | |
1079 safe. (We could replace the factor 2 with (sizeof(long)*8/32.) | |
1080 | |
1081 We can hope it doesn't much matter on versions of X11 earlier than R7. | |
1082 */ | |
1083 if (sizeof(long) == 8 && *actual_format_ret == 32) | |
1084 total_size = 2 * bytes_remaining + 1; | |
1085 else | |
1086 total_size = bytes_remaining + 1; | |
2367 | 1087 *data_ret = xnew_rawbytes (total_size); |
428 | 1088 |
1089 /* Now read, until we've gotten it all. */ | |
1090 while (bytes_remaining) | |
1091 { | |
1092 #if 0 | |
665 | 1093 Bytecount last = bytes_remaining; |
428 | 1094 #endif |
1095 result = | |
1096 XGetWindowProperty (display, window, property, | |
1097 offset/4, buffer_size/4, | |
1098 (delete_p ? True : False), | |
1099 AnyPropertyType, | |
1100 actual_type_ret, actual_format_ret, | |
1101 actual_size_ret, &bytes_remaining, &tmp_data); | |
1102 #if 0 | |
1103 stderr_out ("<< read %d\n", last-bytes_remaining); | |
1104 #endif | |
1105 /* If this doesn't return Success at this point, it means that | |
1106 some clod deleted the selection while we were in the midst of | |
1107 reading it. Deal with that, I guess.... | |
1108 */ | |
1109 if (result != Success) break; | |
3833 | 1110 /* Again we need to compute the number of bytes in our buffer, not |
1111 the number of bytes transferred for the property. */ | |
1112 if (sizeof(long) == 8 && *actual_format_ret == 32) | |
1113 *actual_size_ret *= 8; | |
1114 else | |
1115 *actual_size_ret *= *actual_format_ret / 8; | |
428 | 1116 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret); |
1117 offset += *actual_size_ret; | |
1118 XFree ((char *) tmp_data); | |
1119 } | |
1120 *bytes_ret = offset; | |
1121 } | |
1122 | |
1123 | |
1124 static void | |
1125 receive_incremental_selection (Display *display, Window window, Atom property, | |
1126 /* this one is for error messages only */ | |
2286 | 1127 Lisp_Object UNUSED (target_type), |
665 | 1128 Bytecount min_size_bytes, |
2367 | 1129 Rawbyte **data_ret, |
665 | 1130 Bytecount *size_bytes_ret, |
428 | 1131 Atom *type_ret, int *format_ret, |
1132 unsigned long *size_ret) | |
1133 { | |
1134 /* This function can GC */ | |
665 | 1135 Bytecount offset = 0; |
428 | 1136 int prop_id; |
1137 *size_bytes_ret = min_size_bytes; | |
2367 | 1138 *data_ret = xnew_rawbytes (*size_bytes_ret); |
428 | 1139 #if 0 |
1140 stderr_out ("\nread INCR %d\n", min_size_bytes); | |
1141 #endif | |
1142 /* At this point, we have read an INCR property, and deleted it (which | |
1143 is how we ack its receipt: the sending window will be selecting | |
1144 PropertyNotify events on our window to notice this). | |
1145 | |
1146 Now, we must loop, waiting for the sending window to put a value on | |
1147 that property, then reading the property, then deleting it to ack. | |
1148 We are done when the sender places a property of length 0. | |
1149 */ | |
1150 prop_id = expect_property_change (display, window, property, | |
1151 PropertyNewValue); | |
1152 while (1) | |
1153 { | |
2367 | 1154 Rawbyte *tmp_data; |
665 | 1155 Bytecount tmp_size_bytes; |
428 | 1156 wait_for_property_change (prop_id); |
1157 /* expect it again immediately, because x_get_window_property may | |
1158 .. no it won't, I don't get it. | |
1159 .. Ok, I get it now, the Xt code that implements INCR is broken. | |
1160 */ | |
1161 prop_id = expect_property_change (display, window, property, | |
1162 PropertyNewValue); | |
1163 x_get_window_property (display, window, property, | |
1164 &tmp_data, &tmp_size_bytes, | |
1165 type_ret, format_ret, size_ret, 1); | |
1166 | |
1167 if (tmp_size_bytes == 0) /* we're done */ | |
1168 { | |
1169 #if 0 | |
1170 stderr_out (" read INCR done\n"); | |
1171 #endif | |
1172 unexpect_property_change (prop_id); | |
1726 | 1173 if (tmp_data) |
2367 | 1174 xfree (tmp_data, Rawbyte *); |
428 | 1175 break; |
1176 } | |
1177 #if 0 | |
1178 stderr_out (" read INCR %d\n", tmp_size_bytes); | |
1179 #endif | |
1180 if (*size_bytes_ret < offset + tmp_size_bytes) | |
1181 { | |
1182 #if 0 | |
1183 stderr_out (" read INCR realloc %d -> %d\n", | |
1184 *size_bytes_ret, offset + tmp_size_bytes); | |
1185 #endif | |
1186 *size_bytes_ret = offset + tmp_size_bytes; | |
2367 | 1187 *data_ret = (Rawbyte *) xrealloc (*data_ret, *size_bytes_ret); |
428 | 1188 } |
1189 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes); | |
1190 offset += tmp_size_bytes; | |
2367 | 1191 xfree (tmp_data, Rawbyte *); |
428 | 1192 } |
1193 } | |
1194 | |
1195 | |
1196 static Lisp_Object | |
1197 x_get_window_property_as_lisp_data (Display *display, | |
1198 Window window, | |
1199 Atom property, | |
1200 /* next two for error messages only */ | |
1201 Lisp_Object target_type, | |
1202 Atom selection_atom) | |
1203 { | |
1204 /* This function can GC */ | |
1205 Atom actual_type; | |
1206 int actual_format; | |
1207 unsigned long actual_size; | |
2367 | 1208 Rawbyte *data = NULL; |
665 | 1209 Bytecount bytes = 0; |
428 | 1210 Lisp_Object val; |
1211 struct device *d = get_device_from_display (display); | |
1212 | |
1213 x_get_window_property (display, window, property, &data, &bytes, | |
1214 &actual_type, &actual_format, &actual_size, 1); | |
1215 if (! data) | |
1216 { | |
1217 if (XGetSelectionOwner (display, selection_atom)) | |
1218 /* there is a selection owner */ | |
563 | 1219 signal_error (Qselection_conversion_error, |
1220 "selection owner couldn't convert", | |
1221 Fcons (Qunbound, | |
1222 Fcons (x_atom_to_symbol (d, selection_atom), | |
1223 actual_type ? | |
1224 list2 (target_type, | |
1225 x_atom_to_symbol (d, actual_type)) : | |
1226 list1 (target_type)))); | |
428 | 1227 else |
563 | 1228 signal_error (Qselection_conversion_error, |
1229 "no selection", | |
1230 x_atom_to_symbol (d, selection_atom)); | |
428 | 1231 } |
1232 | |
1233 if (actual_type == DEVICE_XATOM_INCR (d)) | |
1234 { | |
1235 /* Ok, that data wasn't *the* data, it was just the beginning. */ | |
1236 | |
665 | 1237 Bytecount min_size_bytes = |
647 | 1238 /* careful here. */ |
665 | 1239 (Bytecount) (* ((unsigned int *) data)); |
2367 | 1240 xfree (data, Rawbyte *); |
428 | 1241 receive_incremental_selection (display, window, property, target_type, |
1242 min_size_bytes, &data, &bytes, | |
1243 &actual_type, &actual_format, | |
1244 &actual_size); | |
1245 } | |
1246 | |
1247 /* It's been read. Now convert it to a lisp object in some semi-rational | |
1248 manner. */ | |
1249 val = selection_data_to_lisp_data (d, data, bytes, | |
1250 actual_type, actual_format); | |
1251 | |
2367 | 1252 xfree (data, Rawbyte *); |
428 | 1253 return val; |
1254 } | |
1255 | |
1256 | |
1257 /* Called from the event loop to handle SelectionNotify events. | |
1258 I don't think this needs to be reentrant. | |
1259 */ | |
1260 void | |
1261 x_handle_selection_notify (XSelectionEvent *event) | |
1262 { | |
1263 if (! reading_selection_reply) | |
1264 message ("received an unexpected SelectionNotify event"); | |
1265 else if (event->requestor != reading_selection_reply) | |
1266 message ("received a SelectionNotify event for the wrong window"); | |
1267 else if (event->selection != reading_which_selection) | |
1268 message ("received the wrong selection type in SelectionNotify!"); | |
1269 else | |
1270 reading_selection_reply = 0; /* we're done now. */ | |
1271 } | |
1272 | |
1273 static void | |
1274 x_disown_selection (Lisp_Object selection, Lisp_Object timeval) | |
1275 { | |
1276 struct device *d = decode_x_device (Qnil); | |
1277 Display *display = DEVICE_X_DISPLAY (d); | |
1278 Time timestamp; | |
1279 Atom selection_atom; | |
1280 | |
1281 CHECK_SYMBOL (selection); | |
1282 if (NILP (timeval)) | |
1283 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d); | |
1284 else | |
1285 { | |
1286 /* #### This is bogus. See the comment above about problems | |
1287 on OSF/1 and DEC Alphas. Yet another reason why it sucks | |
1288 to have the implementation (i.e. cons of two 16-bit | |
1289 integers) exposed. */ | |
1290 time_t the_time; | |
1291 lisp_to_time (timeval, &the_time); | |
1292 timestamp = (Time) the_time; | |
1293 } | |
1294 | |
1295 selection_atom = symbol_to_x_atom (d, selection, 0); | |
1296 | |
1297 XSetSelectionOwner (display, selection_atom, None, timestamp); | |
1298 } | |
1299 | |
1300 static Lisp_Object | |
442 | 1301 x_selection_exists_p (Lisp_Object selection, |
2286 | 1302 Lisp_Object UNUSED (selection_type)) |
428 | 1303 { |
1304 struct device *d = decode_x_device (Qnil); | |
1305 Display *dpy = DEVICE_X_DISPLAY (d); | |
1306 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ? | |
1307 Qt : Qnil; | |
1308 } | |
1309 | |
1310 | |
1311 #ifdef CUT_BUFFER_SUPPORT | |
1312 | |
1313 static int cut_buffers_initialized; /* Whether we're sure they all exist */ | |
1314 | |
1315 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */ | |
1316 static void | |
1317 initialize_cut_buffers (Display *display, Window window) | |
1318 { | |
442 | 1319 static unsigned const char * const data = (unsigned const char *) ""; |
428 | 1320 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \ |
1321 PropModeAppend, data, 0) | |
1322 FROB (XA_CUT_BUFFER0); | |
1323 FROB (XA_CUT_BUFFER1); | |
1324 FROB (XA_CUT_BUFFER2); | |
1325 FROB (XA_CUT_BUFFER3); | |
1326 FROB (XA_CUT_BUFFER4); | |
1327 FROB (XA_CUT_BUFFER5); | |
1328 FROB (XA_CUT_BUFFER6); | |
1329 FROB (XA_CUT_BUFFER7); | |
1330 #undef FROB | |
1331 cut_buffers_initialized = 1; | |
1332 } | |
1333 | |
1334 #define CHECK_CUTBUFFER(symbol) do { \ | |
1335 CHECK_SYMBOL (symbol); \ | |
1336 if (! (EQ (symbol, QCUT_BUFFER0) || \ | |
1337 EQ (symbol, QCUT_BUFFER1) || \ | |
1338 EQ (symbol, QCUT_BUFFER2) || \ | |
1339 EQ (symbol, QCUT_BUFFER3) || \ | |
1340 EQ (symbol, QCUT_BUFFER4) || \ | |
1341 EQ (symbol, QCUT_BUFFER5) || \ | |
1342 EQ (symbol, QCUT_BUFFER6) || \ | |
1343 EQ (symbol, QCUT_BUFFER7))) \ | |
563 | 1344 invalid_constant ("Doesn't name a cutbuffer", symbol); \ |
428 | 1345 } while (0) |
1346 | |
1347 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /* | |
1348 Return the value of the named CUTBUFFER (typically CUT_BUFFER0). | |
1349 */ | |
1350 (cutbuffer)) | |
1351 { | |
1352 struct device *d = decode_x_device (Qnil); | |
1353 Display *display = DEVICE_X_DISPLAY (d); | |
1354 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
1355 Atom cut_buffer_atom; | |
2367 | 1356 Rawbyte *data; |
665 | 1357 Bytecount bytes; |
428 | 1358 Atom type; |
1359 int format; | |
1360 unsigned long size; | |
1361 Lisp_Object ret; | |
1362 | |
1363 CHECK_CUTBUFFER (cutbuffer); | |
1364 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); | |
1365 | |
1366 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes, | |
1367 &type, &format, &size, 0); | |
1368 if (!data) return Qnil; | |
1369 | |
1370 if (format != 8 || type != XA_STRING) | |
563 | 1371 invalid_state_2 ("Cut buffer doesn't contain 8-bit STRING data", |
1372 x_atom_to_symbol (d, type), | |
1373 make_int (format)); | |
428 | 1374 |
1375 /* We cheat - if the string contains an ESC character, that's | |
1376 technically not allowed in a STRING, so we assume it's | |
1377 COMPOUND_TEXT that we stored there ourselves earlier, | |
1378 in x-store-cutbuffer-internal */ | |
1379 ret = (bytes ? | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3833
diff
changeset
|
1380 make_extstring ((Extbyte *) data, bytes, |
428 | 1381 memchr (data, 0x1b, bytes) ? |
440 | 1382 Qctext : Qbinary) |
428 | 1383 : Qnil); |
2367 | 1384 xfree (data, Rawbyte *); |
428 | 1385 return ret; |
1386 } | |
1387 | |
1388 | |
1389 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /* | |
1390 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING. | |
1391 */ | |
1392 (cutbuffer, string)) | |
1393 { | |
1394 struct device *d = decode_x_device (Qnil); | |
1395 Display *display = DEVICE_X_DISPLAY (d); | |
1396 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
1397 Atom cut_buffer_atom; | |
867 | 1398 const Ibyte *data = XSTRING_DATA (string); |
444 | 1399 Bytecount bytes = XSTRING_LENGTH (string); |
1400 Bytecount bytes_remaining; | |
665 | 1401 Bytecount max_bytes = SELECTION_QUANTUM (display); |
428 | 1402 #ifdef MULE |
867 | 1403 const Ibyte *ptr, *end; |
428 | 1404 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; |
1405 #endif | |
1406 | |
1407 if (max_bytes > MAX_SELECTION_QUANTUM) | |
1408 max_bytes = MAX_SELECTION_QUANTUM; | |
1409 | |
1410 CHECK_CUTBUFFER (cutbuffer); | |
1411 CHECK_STRING (string); | |
1412 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); | |
1413 | |
1414 if (! cut_buffers_initialized) | |
1415 initialize_cut_buffers (display, window); | |
1416 | |
1417 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT. | |
1418 We cheat and use type = `STRING' even when using COMPOUND_TEXT. | |
1419 The ICCCM requires that this be so, and other clients assume it, | |
1420 as we do ourselves in initialize_cut_buffers. */ | |
1421 | |
1422 #ifdef MULE | |
1423 /* Optimize for the common ASCII case */ | |
1424 for (ptr = data, end = ptr + bytes; ptr <= end; ) | |
1425 { | |
826 | 1426 if (byte_ascii_p (*ptr)) |
428 | 1427 { |
1428 ptr++; | |
1429 continue; | |
1430 } | |
1431 | |
1432 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || | |
1433 (*ptr) == LEADING_BYTE_CONTROL_1) | |
1434 { | |
1435 chartypes = LATIN_1; | |
1436 ptr += 2; | |
1437 continue; | |
1438 } | |
1439 | |
1440 chartypes = WORLD; | |
1441 break; | |
1442 } | |
1443 | |
1444 if (chartypes == LATIN_1) | |
440 | 1445 TO_EXTERNAL_FORMAT (LISP_STRING, string, |
1446 ALLOCA, (data, bytes), | |
1447 Qbinary); | |
428 | 1448 else if (chartypes == WORLD) |
440 | 1449 TO_EXTERNAL_FORMAT (LISP_STRING, string, |
1450 ALLOCA, (data, bytes), | |
1451 Qctext); | |
428 | 1452 #endif /* MULE */ |
1453 | |
1454 bytes_remaining = bytes; | |
1455 | |
1456 while (bytes_remaining) | |
1457 { | |
665 | 1458 Bytecount chunk = |
647 | 1459 bytes_remaining < max_bytes ? bytes_remaining : max_bytes; |
428 | 1460 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8, |
1461 (bytes_remaining == bytes | |
1462 ? PropModeReplace : PropModeAppend), | |
1463 data, chunk); | |
1464 data += chunk; | |
1465 bytes_remaining -= chunk; | |
1466 } | |
1467 return string; | |
1468 } | |
1469 | |
1470 | |
1471 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /* | |
1472 Rotate the values of the cutbuffers by the given number of steps; | |
1473 positive means move values forward, negative means backward. | |
1474 */ | |
1475 (n)) | |
1476 { | |
1477 struct device *d = decode_x_device (Qnil); | |
1478 Display *display = DEVICE_X_DISPLAY (d); | |
1479 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
1480 Atom props [8]; | |
1481 | |
1482 CHECK_INT (n); | |
1483 if (XINT (n) == 0) | |
1484 return n; | |
1485 if (! cut_buffers_initialized) | |
1486 initialize_cut_buffers (display, window); | |
1487 props[0] = XA_CUT_BUFFER0; | |
1488 props[1] = XA_CUT_BUFFER1; | |
1489 props[2] = XA_CUT_BUFFER2; | |
1490 props[3] = XA_CUT_BUFFER3; | |
1491 props[4] = XA_CUT_BUFFER4; | |
1492 props[5] = XA_CUT_BUFFER5; | |
1493 props[6] = XA_CUT_BUFFER6; | |
1494 props[7] = XA_CUT_BUFFER7; | |
1495 XRotateWindowProperties (display, window, props, 8, XINT (n)); | |
1496 return n; | |
1497 } | |
1498 | |
1499 #endif /* CUT_BUFFER_SUPPORT */ | |
1500 | |
1501 | |
1502 | |
1503 /************************************************************************/ | |
1504 /* initialization */ | |
1505 /************************************************************************/ | |
1506 | |
1507 void | |
440 | 1508 syms_of_select_x (void) |
428 | 1509 { |
1510 | |
1511 #ifdef CUT_BUFFER_SUPPORT | |
1512 DEFSUBR (Fx_get_cutbuffer_internal); | |
1513 DEFSUBR (Fx_store_cutbuffer_internal); | |
1514 DEFSUBR (Fx_rotate_cutbuffers_internal); | |
1515 #endif /* CUT_BUFFER_SUPPORT */ | |
1516 | |
1517 /* Unfortunately, timeout handlers must be lisp functions. */ | |
563 | 1518 DEFSYMBOL (Qx_selection_reply_timeout_internal); |
428 | 1519 DEFSUBR (Fx_selection_reply_timeout_internal); |
1520 | |
1521 #ifdef CUT_BUFFER_SUPPORT | |
1522 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0"); | |
1523 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1"); | |
1524 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2"); | |
1525 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3"); | |
1526 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4"); | |
1527 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5"); | |
1528 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6"); | |
1529 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7"); | |
1530 #endif /* CUT_BUFFER_SUPPORT */ | |
1531 } | |
1532 | |
1533 void | |
1534 console_type_create_select_x (void) | |
1535 { | |
1536 CONSOLE_HAS_METHOD (x, own_selection); | |
1537 CONSOLE_HAS_METHOD (x, disown_selection); | |
1538 CONSOLE_HAS_METHOD (x, get_foreign_selection); | |
1539 CONSOLE_HAS_METHOD (x, selection_exists_p); | |
1540 } | |
1541 | |
1542 void | |
440 | 1543 reinit_vars_of_select_x (void) |
428 | 1544 { |
1545 reading_selection_reply = 0; | |
1546 reading_which_selection = 0; | |
1547 selection_reply_timed_out = 0; | |
1548 for_whom_the_bell_tolls = 0; | |
1549 prop_location_tick = 0; | |
1550 } | |
1551 | |
1552 void | |
440 | 1553 vars_of_select_x (void) |
428 | 1554 { |
1555 #ifdef CUT_BUFFER_SUPPORT | |
1556 cut_buffers_initialized = 0; | |
1557 Fprovide (intern ("cut-buffer")); | |
1558 #endif | |
1559 | |
1560 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /* | |
1561 A function or functions to be called after we have responded to some | |
1562 other client's request for the value of a selection that we own. The | |
1563 function(s) will be called with four arguments: | |
1564 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); | |
1565 - the name of the selection-type which we were requested to convert the | |
1566 selection into before sending (for example, STRING or LENGTH); | |
1567 - and whether we successfully transmitted the selection. | |
1568 We might have failed (and declined the request) for any number of reasons, | |
1569 including being asked for a selection that we no longer own, or being asked | |
1570 to convert into a type that we don't know about or that is inappropriate. | |
1571 This hook doesn't let you change the behavior of emacs's selection replies, | |
1572 it merely informs you that they have happened. | |
1573 */ ); | |
1574 Vx_sent_selection_hooks = Qunbound; | |
1575 | |
1576 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /* | |
1577 If the selection owner doesn't reply in this many seconds, we give up. | |
1578 A value of 0 means wait as long as necessary. This is initialized from the | |
1579 \"*selectionTimeout\" resource (which is expressed in milliseconds). | |
1580 */ ); | |
1581 x_selection_timeout = 0; | |
456 | 1582 |
1583 DEFVAR_BOOL ("x-selection-strict-motif-ownership", &x_selection_strict_motif_ownership /* | |
863 | 1584 *If nil and XEmacs already owns the clipboard, don't own it again in the |
456 | 1585 Motif way. Owning the selection on the Motif way does a huge amount of |
1586 X protocol, and it makes killing text incredibly slow when using an | |
1587 X terminal. However, when enabled Motif text fields don't bother to look up | |
1588 the new value, and you can't Copy from a buffer, Paste into a text | |
1589 field, then Copy something else from the buffer and paste it into the | |
1590 text field; it pastes the first thing again. | |
1591 */ ); | |
1592 x_selection_strict_motif_ownership = 1; | |
428 | 1593 } |
1594 | |
1595 void | |
440 | 1596 Xatoms_of_select_x (struct device *d) |
428 | 1597 { |
1598 Display *D = DEVICE_X_DISPLAY (d); | |
1599 | |
1600 /* Non-predefined atoms that we might end up using a lot */ | |
1601 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False); | |
1602 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False); | |
1603 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False); | |
1604 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False); | |
1605 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False); | |
1606 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False); | |
1607 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False); | |
1608 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False); | |
1609 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False); | |
1610 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False); | |
442 | 1611 |
1612 /* #### I don't like the looks of this... what is it for? - ajh */ | |
428 | 1613 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False); |
1614 } |