cgit.sxemacs.org Git - sxemacs/blob - src/ui/select.c

   1 /* Generic selection processing for SXEmacs
   2    Copyright (C) 1999 Free Software Foundation, Inc.
   3    Copyright (C) 1999 Andy Piper.
   4
   5 This file is part of SXEmacs
   6
   7 SXEmacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 SXEmacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  19
  20
  21 /* Synched up with: Not synched with FSF. */
  22
  23 #include <config.h>
  24 #include "lisp.h"
  25
  26 #include "buffer.h"
  27 #include "device.h"
  28 #include "extents.h"
  29 #include "console.h"
  30 #include "objects.h"
  31
  32 #include "frame.h"
  33 #include "opaque.h"
  34 #include "select.h"
  35
  36 /* X Atoms */
  37 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
  38     QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
  39     QATOM_PAIR, QCOMPOUND_TEXT;
  40
  41 /* Selection strategy symbols */
  42 Lisp_Object Qreplace_all, Qreplace_existing;
  43
  44 /* "Selection owner couldn't convert selection" */
  45 Lisp_Object Qselection_conversion_error;
  46
  47 /* A couple of Lisp functions */
  48 Lisp_Object Qselect_convert_in, Qselect_convert_out, Qselect_coerce;
  49
  50 /* These are alists whose CARs are selection-types (whose names are the same
  51    as the names of X Atoms or Windows clipboard formats) and whose CDRs are
  52    the names of Lisp functions to call to convert the given Emacs selection
  53    value to a string representing the given selection type.  This is for
  54    elisp-level extension of the emacs selection handling.
  55  */
  56 Lisp_Object Vselection_converter_out_alist;
  57 Lisp_Object Vselection_converter_in_alist;
  58 Lisp_Object Vselection_coercion_alist;
  59 Lisp_Object Vselection_appender_alist;
  60 Lisp_Object Vselection_buffer_killed_alist;
  61 Lisp_Object Vselection_coercible_types;
  62
  63 Lisp_Object Vlost_selection_hooks;
  64
  65 /* This is an association list whose elements are of the form
  66      ( selection-name selection-value selection-timestamp )
  67    selection-name is a lisp symbol, whose name is the name of an X Atom.
  68    selection-value is a list of cons pairs that emacs owns for that selection.
  69      Each pair consists of (type . value), where type is nil or a
  70      selection data type, and value is any type of Lisp object.
  71    selection-timestamp is the time at which emacs began owning this selection,
  72      as a cons of two 16-bit numbers (making a 32 bit time).
  73    If there is an entry in this alist, then it can be assumed that emacs owns
  74     that selection.
  75    The only (eq) parts of this list that are visible from elisp are the
  76     selection-values.
  77  */
  78 Lisp_Object Vselection_alist;
  79
  80 /* Given a selection-name and desired type, this looks up our local copy of
  81    the selection value and converts it to the type. */
  82 static Lisp_Object
  83 get_local_selection(Lisp_Object selection_symbol, Lisp_Object target_type)
  84 {
  85         Lisp_Object local_value =
  86             assq_no_quit(selection_symbol, Vselection_alist);
  87
  88         if (!NILP(local_value)) {
  89                 Lisp_Object value_list = XCAR(XCDR(local_value));
  90                 Lisp_Object value;
  91
  92                 /* First try to find an entry of the appropriate type */
  93                 value = assq_no_quit(target_type, value_list);
  94
  95                 if (!NILP(value))
  96                         return XCDR(value);
  97         }
  98
  99         return Qnil;
 100 }
 101
 102 /* #### Should perhaps handle 'MULTIPLE. The code below is now completely
 103    broken due to a re-organization of get_local_selection, but I've left
 104    it here should anyone show an interest - ajh */
 105 #if 0
 106 else
 107 if (CONSP(target_type) && XCAR(target_type) == QMULTIPLE) {
 108 Lisp_Object pairs = XCDR(target_type);
 109 int len = XVECTOR_LENGTH(pairs);
 110 int i;
 111           /* If the target is MULTIPLE, then target_type looks like
 112              (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
 113              We modify the second element of each pair in the vector and
 114              return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
 115            */
 116 for (i = 0; i < len; i++) {
 117         Lisp_Object pair = XVECTOR_DATA(pairs)[i];
 118         XVECTOR_DATA(pair)[1] =
 119             x_get_local_selection(XVECTOR_DATA(pair)[0], XVECTOR_DATA(pair)[1]);
 120 }
 121 return pairs;
 122 }
 123 #endif
 124
 125 DEFUN("own-selection-internal", Fown_selection_internal, 2, 5, 0,       /*
 126 Give the selection SELECTION-NAME the value SELECTION-VALUE.
 127 SELECTION-NAME is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
 128 SELECTION-VALUE is typically a string, or a cons of two markers, but may be
 129 anything that the functions on selection-converter-out-alist know about.
 130 Optional arg HOW-TO-ADD specifies how the selection will be combined
 131 with any existing selection(s) - see `own-selection' for more
 132 information.
 133 Optional arg DATA-TYPE is a window-system-specific type.
 134 Optional arg DEVICE specifies the device on which to assert the selection.
 135 It defaults to the selected device.
 136 */
 137       (selection_name, selection_value, how_to_add, data_type, device))
 138 {
 139         Lisp_Object selection_time, selection_data, prev_value = Qnil,
 140             value_list = Qnil;
 141         Lisp_Object prev_real_value = Qnil;
 142         struct gcpro gcpro1;
 143         int owned_p = 0;
 144
 145         CHECK_SYMBOL(selection_name);
 146         if (NILP(selection_value))
 147                 error("selection-value may not be nil.");
 148
 149         if (NILP(device))
 150                 device = Fselected_device(Qnil);
 151
 152         if (!EQ(how_to_add, Qappend) && !EQ(how_to_add, Qt)
 153             && !EQ(how_to_add, Qreplace_existing)
 154             && !EQ(how_to_add, Qreplace_all) && !NILP(how_to_add))
 155                 error("how-to-add must be nil, append, replace_all, "
 156                       "replace_existing or t.");
 157
 158 #ifdef MULE
 159         if (NILP(data_type))
 160                 data_type = QCOMPOUND_TEXT;
 161 #else
 162         if (NILP(data_type))
 163                 data_type = QSTRING;
 164 #endif
 165
 166         /* Examine the how-to-add argument */
 167         if (EQ(how_to_add, Qreplace_all) || NILP(how_to_add)) {
 168                 Lisp_Object local_selection_data = assq_no_quit(selection_name,
 169                                                                 Vselection_alist);
 170
 171                 if (!NILP(local_selection_data)) {
 172                         owned_p = 1;
 173                         /* Don't use Fdelq() as that may QUIT;. */
 174                         if (EQ(local_selection_data, Fcar(Vselection_alist)))
 175                                 Vselection_alist = Fcdr(Vselection_alist);
 176                         else {
 177                                 Lisp_Object rest;
 178                                 for (rest = Vselection_alist; !NILP(rest);
 179                                      rest = Fcdr(rest))
 180                                         if (EQ
 181                                             (local_selection_data,
 182                                              Fcar(XCDR(rest)))) {
 183                                                 XCDR(rest) = Fcdr(XCDR(rest));
 184                                                 break;
 185                                         }
 186                         }
 187                 }
 188         } else {
 189                 /* Look for a previous value */
 190                 prev_value = assq_no_quit(selection_name, Vselection_alist);
 191
 192                 if (!NILP(prev_value)) {
 193                         owned_p = 1;
 194                         value_list = XCAR(XCDR(prev_value));
 195                 }
 196
 197                 if (!NILP(value_list))
 198                         prev_real_value = assq_no_quit(data_type, value_list);
 199         }
 200
 201         /* Append values if necessary */
 202         if (!NILP(value_list)
 203             && (EQ(how_to_add, Qappend) || EQ(how_to_add, Qt))) {
 204                 /* Did we have anything of this type previously? */
 205                 if (!NILP(prev_real_value)) {
 206                         if ((NILP(data_type) && STRINGP(selection_value)
 207                              && STRINGP(XCDR(prev_real_value)))
 208                             || !NILP(data_type)) {
 209                                 Lisp_Object function = assq_no_quit(data_type,
 210                                                                     Vselection_appender_alist);
 211
 212                                 if (NILP(function))
 213                                         error
 214                                             ("cannot append selections of supplied types.");
 215
 216                                 function = XCDR(function);
 217
 218                                 selection_value = call4(function,
 219                                                         selection_name,
 220                                                         data_type,
 221                                                         XCDR(prev_real_value),
 222                                                         selection_value);
 223
 224                                 if (NILP(selection_value))
 225                                         error
 226                                             ("cannot append selections of supplied types.");
 227                         } else
 228                                 error
 229                                     ("cannot append selections of supplied types.");
 230                 }
 231
 232                 selection_data = Fcons(data_type, selection_value);
 233                 value_list = Fcons(selection_data, value_list);
 234         }
 235
 236         if (!NILP(prev_real_value)) {
 237                 Lisp_Object rest;       /* We know it isn't the CAR, so it's easy. */
 238
 239                 /* Delete the old type entry from the list */
 240                 for (rest = value_list; !NILP(rest); rest = Fcdr(rest))
 241                         if (EQ(prev_real_value, Fcar(XCDR(rest)))) {
 242                                 XCDR(rest) = Fcdr(XCDR(rest));
 243                                 break;
 244                         }
 245         } else {
 246                 value_list = Fcons(Fcons(data_type, selection_value),
 247                                    value_list);
 248         }
 249
 250         /* Complete the local cache update; note that we destructively
 251            modify the current list entry if there is one */
 252         if (NILP(prev_value)) {
 253                 selection_data = list3(selection_name, value_list, Qnil);
 254                 Vselection_alist = Fcons(selection_data, Vselection_alist);
 255         } else {
 256                 selection_data = prev_value;
 257                 Fsetcar(XCDR(selection_data), value_list);
 258         }
 259
 260         GCPRO1(selection_data);
 261
 262         /* have to do device specific stuff last so that methods can access the
 263            selection_alist */
 264         if (HAS_DEVMETH_P(XDEVICE(device), own_selection))
 265                 selection_time = DEVMETH(XDEVICE(device), own_selection,
 266                                          (selection_name, selection_value,
 267                                           how_to_add, data_type, owned_p));
 268         else
 269                 selection_time = Qnil;
 270
 271         Fsetcar(XCDR(XCDR(selection_data)), selection_time);
 272
 273         UNGCPRO;
 274
 275         return selection_value;
 276 }
 277
 278 DEFUN("register-selection-data-type", Fregister_selection_data_type, 1, 2, 0,   /*
 279 Register a new selection data type DATA-TYPE, optionally on the specified
 280 DEVICE. Returns the device-specific data type identifier, or nil if the
 281 device does not support this feature or the registration fails.
 282 */
 283       (data_type, device))
 284 {
 285         /* Check arguments */
 286         CHECK_STRING(data_type);
 287
 288         if (NILP(device))
 289                 device = Fselected_device(Qnil);
 290
 291         if (HAS_DEVMETH_P(XDEVICE(device), register_selection_data_type))
 292                 return DEVMETH(XDEVICE(device), register_selection_data_type,
 293                                (data_type));
 294         else
 295                 return Qnil;
 296 }
 297
 298 DEFUN("selection-data-type-name", Fselection_data_type_name, 1, 2, 0,   /*
 299 Retrieve the name of the specified selection data type DATA-TYPE, optionally
 300 on the specified DEVICE. Returns either a string or a symbol on success, and
 301 nil if the device does not support this feature or the type is not known.
 302 */
 303       (data_type, device))
 304 {
 305         if (NILP(device))
 306                 device = Fselected_device(Qnil);
 307
 308         if (HAS_DEVMETH_P(XDEVICE(device), selection_data_type_name))
 309                 return DEVMETH(XDEVICE(device), selection_data_type_name,
 310                                (data_type));
 311         else
 312                 return Qnil;
 313 }
 314
 315 DEFUN("available-selection-types", Favailable_selection_types, 1, 2, 0, /*
 316 Retrieve a list of currently available types of selection associated with
 317 the given SELECTION-NAME, optionally on the specified DEVICE. This list
 318 does not take into account any possible conversions that might take place,
 319 so it should be taken as a minimal estimate of what is available.
 320 */
 321       (selection_name, device))
 322 {
 323         Lisp_Object types = Qnil, rest;
 324         struct gcpro gcpro1;
 325
 326         CHECK_SYMBOL(selection_name);
 327
 328         if (NILP(device))
 329                 device = Fselected_device(Qnil);
 330
 331         GCPRO1(types);
 332
 333         /* First check the device */
 334         if (HAS_DEVMETH_P(XDEVICE(device), available_selection_types))
 335                 types = DEVMETH(XDEVICE(device), available_selection_types,
 336                                 (selection_name));
 337
 338         /* Now look in the list */
 339         rest = assq_no_quit(selection_name, Vselection_alist);
 340
 341         if (NILP(rest)) {
 342                 UNGCPRO;
 343
 344                 return types;
 345         }
 346
 347         /* Examine the types and cons them onto the front of the list */
 348         for (rest = XCAR(XCDR(rest)); !NILP(rest); rest = XCDR(rest)) {
 349                 Lisp_Object value = XCDR(XCAR(rest));
 350                 Lisp_Object type = XCAR(XCAR(rest));
 351
 352                 types = Fcons(type, types);
 353
 354                 if ((STRINGP(value) || EXTENTP(value))
 355                     && (NILP(type) || EQ(type, QSTRING)
 356                         || EQ(type, QTEXT) || EQ(type, QCOMPOUND_TEXT)))
 357                         types =
 358                             Fcons(QTEXT,
 359                                   Fcons(QCOMPOUND_TEXT, Fcons(QSTRING, types)));
 360                 else if (INTP(value) && NILP(type))
 361                         types = Fcons(QINTEGER, types);
 362                 else if (SYMBOLP(value) && NILP(type))
 363                         types = Fcons(QATOM, types);
 364         }
 365
 366         UNGCPRO;
 367
 368         return types;
 369 }
 370
 371 /* remove a selection from our local copy
 372  */
 373 void handle_selection_clear(Lisp_Object selection_symbol)
 374 {
 375         Lisp_Object local_selection_data = assq_no_quit(selection_symbol,
 376                                                         Vselection_alist);
 377
 378         /* Well, we already believe that we don't own it, so that's just fine. */
 379         if (NILP(local_selection_data))
 380                 return;