git.chise.org Git - chise/xemacs-chise.git.1/blob - src/select.c

   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"
  28 #include "device.h"
  29 #include "console.h"
  30 #include "objects.h"
  31
  32 #include "frame.h"
  33 #include "opaque.h"
  34 #include "select.h"
  35
  36 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
  37   QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
  38   QATOM_PAIR, QCOMPOUND_TEXT;
  39
  40 /* "Selection owner couldn't convert selection" */
  41 Lisp_Object Qselection_conversion_error;
  42
  43 /* This is an alist whose CARs are selection-types (whose names are the same
  44    as the names of X Atoms) and whose CDRs are the names of Lisp functions to
  45    call to convert the given Emacs selection value to a string representing
  46    the given selection type.  This is for elisp-level extension of the emacs
  47    selection handling.
  48  */
  49 Lisp_Object Vselection_converter_alist;
  50
  51 Lisp_Object Vlost_selection_hooks;
  52
  53 /* This is an association list whose elements are of the form
  54      ( selection-name selection-value selection-timestamp )
  55    selection-name is a lisp symbol, whose name is the name of an X Atom.
  56    selection-value is the value that emacs owns for that selection.
  57      It may be any kind of Lisp object.
  58    selection-timestamp is the time at which emacs began owning this selection,
  59      as a cons of two 16-bit numbers (making a 32 bit time).
  60    If there is an entry in this alist, then it can be assumed that emacs owns
  61     that selection.
  62    The only (eq) parts of this list that are visible from elisp are the
  63     selection-values.
  64  */
  65 Lisp_Object Vselection_alist;
  66
  67 static Lisp_Object
  68 clean_local_selection_data (Lisp_Object obj)
  69 {
  70   if (CONSP (obj) &&
  71       INTP (XCAR (obj)) &&
  72       CONSP (XCDR (obj)) &&
  73       INTP (XCAR (XCDR (obj))) &&
  74       NILP (XCDR (XCDR (obj))))
  75     obj = Fcons (XCAR (obj), XCDR (obj));
  76
  77   if (CONSP (obj) &&
  78       INTP (XCAR (obj)) &&
  79       INTP (XCDR (obj)))
  80     {
  81       if (XINT (XCAR (obj)) == 0)
  82         return XCDR (obj);
  83       if (XINT (XCAR (obj)) == -1)
  84         return make_int (- XINT (XCDR (obj)));
  85     }
  86   if (VECTORP (obj))
  87     {
  88       int i;
  89       int len = XVECTOR_LENGTH (obj);
  90       Lisp_Object copy;
  91       if (len == 1)
  92         return clean_local_selection_data (XVECTOR_DATA (obj) [0]);
  93       copy = make_vector (len, Qnil);
  94       for (i = 0; i < len; i++)
  95         XVECTOR_DATA (copy) [i] =
  96           clean_local_selection_data (XVECTOR_DATA (obj) [i]);
  97       return copy;
  98     }
  99   return obj;
 100 }
 101
 102 /* Given a selection-name and desired type, this looks up our local copy of
 103    the selection value and converts it to the type.  It returns nil or a
 104    string.  This calls random elisp code, and may signal or gc.
 105  */
 106 Lisp_Object
 107 get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
 108 {
 109   /* This function can GC */
 110   Lisp_Object handler_fn, value, check;
 111   Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist);
 112
 113   if (NILP (local_value)) return Qnil;
 114
 115   /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
 116   if (EQ (target_type, QTIMESTAMP))
 117     {
 118       handler_fn = Qnil;
 119       value = XCAR (XCDR (XCDR (local_value)));
 120     }
 121
 122 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
 123   else if (CONSP (target_type) &&
 124            XCAR (target_type) == QMULTIPLE)
 125     {
 126       Lisp_Object pairs = XCDR (target_type);
 127       int len = XVECTOR_LENGTH (pairs);
 128       int i;
 129       /* If the target is MULTIPLE, then target_type looks like
 130           (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
 131          We modify the second element of each pair in the vector and
 132          return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
 133        */
 134       for (i = 0; i < len; i++)
 135         {
 136           Lisp_Object pair = XVECTOR_DATA (pairs) [i];
 137           XVECTOR_DATA (pair) [1] =
 138             x_get_local_selection (XVECTOR_DATA (pair) [0],
 139                                    XVECTOR_DATA (pair) [1]);
 140         }
 141       return pairs;
 142     }
 143 #endif
 144   else
 145     {
 146       CHECK_SYMBOL (target_type);
 147       handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
 148       if (NILP (handler_fn)) return Qnil;
 149       value = call3 (handler_fn,
 150                      selection_symbol, target_type,
 151                      XCAR (XCDR (local_value)));
 152     }
 153
 154   /* This lets the selection function to return (TYPE . VALUE).  For example,
 155      when the selected type is LINE_NUMBER, the returned type is SPAN, not
 156      INTEGER.
 157    */
 158   check = value;
 159   if (CONSP (value) && SYMBOLP (XCAR (value)))
 160     check = XCDR (value);
 161
 162   /* Strings, vectors, and symbols are converted to selection data format in
 163      the obvious way.  Integers are converted to 16 bit quantities if they're
 164      small enough, otherwise 32 bits are used.
 165    */
 166   if (STRINGP (check) ||
 167       VECTORP (check) ||
 168       SYMBOLP (check) ||
 169       INTP    (check) ||
 170       CHARP   (check) ||
 171       NILP (value))
 172     return value;
 173
 174   /* (N . M) or (N M) get turned into a 32 bit quantity.  So if you want to
 175      always return a small quantity as 32 bits, your converter routine needs
 176      to return a cons.
 177    */
 178   else if (CONSP (check) &&
 179            INTP (XCAR (check)) &&
 180            (INTP (XCDR (check)) ||
 181             (CONSP (XCDR (check)) &&
 182              INTP (XCAR (XCDR (check))) &&
 183              NILP (XCDR (XCDR (check))))))
 184     return value;
 185   /* Otherwise the lisp converter function returned something unrecognized.
 186    */
 187   else
 188     signal_error (Qerror,
 189                   list3 (build_string
 190                          ("unrecognized selection-conversion type"),
 191                          handler_fn,
 192                          value));
 193
 194   return Qnil;  /* suppress compiler warning */
 195 }
 196
 197 DEFUN ("own-selection-internal", Fown_selection_internal, 2, 3, 0, /*
 198 Assert a selection of the given TYPE with the given VALUE.
 199 TYPE is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
 200 VALUE is typically a string, or a cons of two markers, but may be
 201 anything that the functions on selection-converter-alist know about.
 202 */
 203        (selection_name, selection_value, device))
 204 {
 205   Lisp_Object selection_time, selection_data, prev_value;
 206   struct gcpro gcpro1;
 207
 208   CHECK_SYMBOL (selection_name);
 209   if (NILP (selection_value)) error ("selection-value may not be nil.");
 210
 211   if (NILP (device))
 212     device = Fselected_device (Qnil);
 213
 214   /* Now update the local cache */
 215   selection_data = list3 (selection_name,
 216                           selection_value,
 217                           Qnil);
 218   GCPRO1 (selection_data);
 219
 220   prev_value = assq_no_quit (selection_name, Vselection_alist);
 221   Vselection_alist = Fcons (selection_data, Vselection_alist);
 222
 223   /* If we already owned the selection, remove the old selection data.
 224      Perhaps we should destructively modify it instead.
 225      Don't use Fdelq() as that may QUIT;.
 226   */
 227   if (!NILP (prev_value))
 228     {
 229       Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
 230       for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 231         if (EQ (prev_value, Fcar (XCDR (rest))))
 232           {
 233             XCDR (rest) = Fcdr (XCDR (rest));
 234             break;
 235           }
 236     }
 237
 238   /* have to do device specific stuff last so that methods can access the
 239      selection_alist */
 240   if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
 241     selection_time = DEVMETH (XDEVICE (device), own_selection,
 242                               (selection_name, selection_value));
 243   else
 244     selection_time = Qnil;
 245
 246   Fsetcar (XCDR (XCDR (selection_data)), selection_time);
 247
 248   UNGCPRO;
 249
 250   return selection_value;
 251 }
 252
 253 /* remove a selection from our local copy
 254  */
 255 void
 256 handle_selection_clear (Lisp_Object selection_symbol)
 257 {
 258   Lisp_Object local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
 259
 260   /* Well, we already believe that we don't own it, so that's just fine. */
 261   if (NILP (local_selection_data)) return;
 262
 263   /* Otherwise, we're really honest and truly being told to drop it.
 264      Don't use Fdelq() as that may QUIT;.
 265    */
 266   if (EQ (local_selection_data, Fcar (Vselection_alist)))
 267     Vselection_alist = Fcdr (Vselection_alist);
 268   else
 269     {
 270       Lisp_Object rest;
 271       for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 272         if (EQ (local_selection_data, Fcar (XCDR (rest))))
 273           {
 274             XCDR (rest) = Fcdr (XCDR (rest));
 275             break;
 276           }
 277     }
 278
 279   /* Let random lisp code notice that the selection has been stolen.
 280    */
 281   {
 282     Lisp_Object rest;
 283     Lisp_Object val = Vlost_selection_hooks;
 284     if (!UNBOUNDP (val) && !NILP (val))
 285       {
 286         if (CONSP (val) && !EQ (XCAR (val), Qlambda))
 287           for (rest = val; !NILP (rest); rest = Fcdr (rest))
 288             call1 (Fcar (rest), selection_symbol);
 289         else
 290           call1 (val, selection_symbol);
 291       }
 292   }
 293 }
 294
 295 DEFUN ("disown-selection-internal", Fdisown_selection_internal, 1, 3, 0, /*
 296 If we own the named selection, then disown it (make there be no selection).
 297 */
 298        (selection_name, selection_time, device))
 299 {
 300   if (NILP (assq_no_quit (selection_name, Vselection_alist)))
 301     return Qnil;  /* Don't disown the selection when we're not the owner. */
 302
 303   if (NILP (device))
 304     device = Fselected_device (Qnil);
 305
 306   MAYBE_DEVMETH (XDEVICE (device), disown_selection,
 307                  (selection_name, selection_time));
 308
 309   handle_selection_clear (selection_name);
 310
 311   return Qt;
 312 }
 313
 314 DEFUN ("selection-owner-p", Fselection_owner_p, 0, 1, 0, /*
 315 Return t if current emacs process owns the given Selection.
 316 The arg should be the name of the selection in question, typically one of
 317 the symbols PRIMARY, SECONDARY, or CLIPBOARD.  (For convenience, the symbol
 318 nil is the same as PRIMARY, and t is the same as SECONDARY.)
 319 */
 320        (selection))
 321 {
 322   CHECK_SYMBOL (selection);
 323   if      (EQ (selection, Qnil)) selection = QPRIMARY;
 324   else if (EQ (selection, Qt))   selection = QSECONDARY;
 325
 326   return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt;
 327 }
 328
 329 DEFUN ("selection-exists-p", Fselection_exists_p, 0, 2, 0, /*
 330 Whether there is an owner for the given Selection.
 331 The arg should be the name of the selection in question, typically one of
 332 the symbols PRIMARY, SECONDARY, or CLIPBOARD.  (For convenience, the symbol
 333 nil is the same as PRIMARY, and t is the same as SECONDARY.)
 334 */
 335        (selection, device))
 336 {
 337   CHECK_SYMBOL (selection);
 338   if (!NILP (Fselection_owner_p (selection)))
 339     return Qt;
 340
 341   if (NILP (device))
 342     device = Fselected_device (Qnil);
 343
 344   return HAS_DEVMETH_P (XDEVICE (device), selection_exists_p) ?
 345     DEVMETH (XDEVICE (device), selection_exists_p, (selection))
 346     : Qnil;
 347 }
 348
 349 /* Request the selection value from the owner.  If we are the owner,
 350    simply return our selection value.  If we are not the owner, this
 351    will block until all of the data has arrived.
 352  */
 353 DEFUN ("get-selection-internal", Fget_selection_internal, 2, 3, 0, /*
 354 Return text selected from some window-system window.
 355 SELECTION_SYMBOL is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
 356 TARGET_TYPE is the type of data desired, typically STRING or COMPOUND_TEXT.
 357 Under Mule, if the resultant data comes back as 8-bit data in type
 358 TEXT or COMPOUND_TEXT, it will be decoded as Compound Text.
 359 */
 360        (selection_symbol, target_type, device))
 361 {
 362   /* This function can GC */
 363   Lisp_Object val = Qnil;
 364   struct gcpro gcpro1, gcpro2;
 365   GCPRO2 (target_type, val); /* we store newly consed data into these */
 366   CHECK_SYMBOL (selection_symbol);
 367
 368   if (NILP (device))
 369     device = Fselected_device (Qnil);
 370
 371 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
 372   if (CONSP (target_type) &&
 373       XCAR (target_type) == QMULTIPLE)
 374     {
 375       CHECK_VECTOR (XCDR (target_type));
 376       /* So we don't destructively modify this... */
 377       target_type = copy_multiple_data (target_type);
 378     }
 379   else
 380 #endif
 381     CHECK_SYMBOL (target_type);
 382
 383   val = get_local_selection (selection_symbol, target_type);
 384
 385   if (NILP (val) && (HAS_DEVMETH_P (XDEVICE (device), get_foreign_selection)))
 386     {
 387       val = DEVMETH (XDEVICE (device), get_foreign_selection,
 388                      (selection_symbol, target_type));
 389     }
 390   else
 391     {
 392       if (CONSP (val) && SYMBOLP (XCAR (val)))
 393         {
 394           val = XCDR (val);
 395           if (CONSP (val) && NILP (XCDR (val)))
 396             val = XCAR (val);
 397         }
 398       val = clean_local_selection_data (val);
 399     }
 400   UNGCPRO;
 401   return val;
 402 }
 403
 404 void
 405 syms_of_select (void)
 406 {
 407   DEFSUBR (Fown_selection_internal);
 408   DEFSUBR (Fget_selection_internal);
 409   DEFSUBR (Fselection_exists_p);
 410   DEFSUBR (Fdisown_selection_internal);
 411   DEFSUBR (Fselection_owner_p);
 412
 413   defsymbol (&QPRIMARY, "PRIMARY");
 414   defsymbol (&QSECONDARY, "SECONDARY");
 415   defsymbol (&QSTRING, "STRING");
 416   defsymbol (&QINTEGER, "INTEGER");
 417   defsymbol (&QCLIPBOARD, "CLIPBOARD");
 418   defsymbol (&QTIMESTAMP, "TIMESTAMP");
 419   defsymbol (&QTEXT, "TEXT");
 420   defsymbol (&QDELETE, "DELETE");
 421   defsymbol (&QMULTIPLE, "MULTIPLE");
 422   defsymbol (&QINCR, "INCR");
 423   defsymbol (&QEMACS_TMP, "_EMACS_TMP_");
 424   defsymbol (&QTARGETS, "TARGETS");
 425   defsymbol (&QATOM, "ATOM");
 426   defsymbol (&QATOM_PAIR, "ATOM_PAIR");
 427   defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT");
 428   defsymbol (&QNULL, "NULL");
 429
 430   deferror (&Qselection_conversion_error,
 431             "selection-conversion-error",
 432             "selection-conversion error", Qio_error);
 433 }
 434
 435 void
 436 vars_of_select (void)
 437 {
 438   Vselection_alist = Qnil;
 439   staticpro (&Vselection_alist);
 440
 441   DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist /*
 442 An alist associating selection-types (such as STRING and TIMESTAMP) with
 443 functions.  These functions will be called with three args: the name
 444 of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a
 445 desired type to which the selection should be converted; and the local
 446 selection value (whatever had been passed to `own-selection').  For
 447 historical reasons these functions should return the value to send to
 448 an X server, which should be one of:
 449
 450 -- nil (the conversion could not be done)
 451 -- a cons of a symbol and any of the following values; the symbol
 452    explicitly specifies the type that will be sent.
 453 -- a string (If the type is not specified, then if Mule support exists,
 454              the string will be converted to Compound Text and sent in
 455              the 'COMPOUND_TEXT format; otherwise (no Mule support),
 456              the string will be left as-is and sent in the 'STRING
 457              format.  If the type is specified, the string will be
 458              left as-is (or converted to binary format under Mule).
 459              In all cases, 8-bit data it sent.)
 460 -- a character (With Mule support, will be converted to Compound Text
 461                 whether or not a type is specified.  If a type is not
 462                 specified, a type of 'STRING or 'COMPOUND_TEXT will be
 463                 sent, as for strings.)
 464 -- the symbol 'NULL (Indicates that there is no meaningful return value.
 465                      Empty 32-bit data with a type of 'NULL will be sent.)
 466 -- a symbol (Will be converted into an atom.  If the type is not specified,
 467              a type of 'ATOM will be sent.)
 468 -- an integer (Will be converted into a 16-bit or 32-bit integer depending
 469                on the value.  If the type is not specified, a type of
 470                'INTEGER will be sent.)
 471 -- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer.
 472                                     If the type is not specified, a type of
 473                                     'INTEGER will be sent.)
 474 -- a vector of symbols (Will be converted into a list of atoms.  If the type
 475                         is not specified, a type of 'ATOM will be sent.)
 476 -- a vector of integers (Will be converted into a list of 16-bit integers.
 477                          If the type is not specified, a type of 'INTEGER
 478                          will be sent.)
 479 -- a vector of integers and/or conses (HIGH . LOW) of integers
 480                         (Will be converted into a list of 16-bit integers.
 481                          If the type is not specified, a type of 'INTEGER
 482                          will be sent.)  */ );
 483   Vselection_converter_alist = Qnil;
 484
 485   DEFVAR_LISP ("lost-selection-hooks", &Vlost_selection_hooks /*
 486 A function or functions to be called after we have been notified
 487 that we have lost the selection.  The function(s) will be called with one
 488 argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or
 489 CLIPBOARD).
 490 */ );
 491   Vlost_selection_hooks = Qunbound;
 492 }
 493