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
 207   CHECK_SYMBOL (selection_name);
 208   if (NILP (selection_value)) error ("selection-value may not be nil.");
 209
 210   if (NILP (device))
 211     device = Fselected_device (Qnil);
 212
 213   /* Now update the local cache */
 214   selection_data = list3 (selection_name,
 215                           selection_value,
 216                           Qnil);
 217   prev_value = assq_no_quit (selection_name, Vselection_alist);
 218   Vselection_alist = Fcons (selection_data, Vselection_alist);
 219
 220   /* If we already owned the selection, remove the old selection data.
 221      Perhaps we should destructively modify it instead.
 222      Don't use Fdelq() as that may QUIT;.
 223   */
 224   if (!NILP (prev_value))
 225     {
 226       Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
 227       for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 228         if (EQ (prev_value, Fcar (XCDR (rest))))
 229           {
 230             XCDR (rest) = Fcdr (XCDR (rest));
 231             break;
 232           }
 233     }
 234
 235   /* have to do device specific stuff last so that methods can access the
 236      selection_alist */
 237   if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
 238     selection_time = DEVMETH (XDEVICE (device), own_selection,
 239                               (selection_name, selection_value));
 240   else
 241     selection_time = Qnil;
 242
 243   Fsetcar (XCDR (XCDR (selection_data)), selection_time);
 244
 245   return selection_value;
 246 }
 247
 248 /* remove a selection from our local copy
 249  */
 250 void
 251 handle_selection_clear (Lisp_Object selection_symbol)
 252 {
 253   Lisp_Object local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
 254
 255   /* Well, we already believe that we don't own it, so that's just fine. */
 256   if (NILP (local_selection_data)) return;
 257
 258   /* Otherwise, we're really honest and truly being told to drop it.
 259      Don't use Fdelq() as that may QUIT;.
 260    */
 261   if (EQ (local_selection_data, Fcar (Vselection_alist)))
 262     Vselection_alist = Fcdr (Vselection_alist);
 263   else
 264     {
 265       Lisp_Object rest;
 266       for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 267         if (EQ (local_selection_data, Fcar (XCDR (rest))))
 268           {
 269             XCDR (rest) = Fcdr (XCDR (rest));
 270             break;
 271           }
 272     }
 273
 274   /* Let random lisp code notice that the selection has been stolen.
 275    */
 276   {
 277     Lisp_Object rest;
 278     Lisp_Object val = Vlost_selection_hooks;
 279     if (!UNBOUNDP (val) && !NILP (val))
 280       {
 281         if (CONSP (val) && !EQ (XCAR (val), Qlambda))
 282           for (rest = val; !NILP (rest); rest = Fcdr (rest))
 283             call1 (Fcar (rest), selection_symbol);
 284         else
 285           call1 (val, selection_symbol);
 286       }
 287   }
 288 }
 289
 290 DEFUN ("disown-selection-internal", Fdisown_selection_internal, 1, 3, 0, /*
 291 If we own the named selection, then disown it (make there be no selection).
 292 */
 293        (selection_name, selection_time, device))
 294 {
 295   if (NILP (assq_no_quit (selection_name, Vselection_alist)))
 296     return Qnil;  /* Don't disown the selection when we're not the owner. */
 297
 298   if (NILP (device))
 299     device = Fselected_device (Qnil);
 300
 301   MAYBE_DEVMETH (XDEVICE (device), disown_selection,
 302                  (selection_name, selection_time));
 303
 304   handle_selection_clear (selection_name);
 305
 306   return Qt;
 307 }
 308
 309 DEFUN ("selection-owner-p", Fselection_owner_p, 0, 1, 0, /*
 310 Return t if current emacs process owns the given Selection.
 311 The arg should be the name of the selection in question, typically one of
 312 the symbols PRIMARY, SECONDARY, or CLIPBOARD.  (For convenience, the symbol
 313 nil is the same as PRIMARY, and t is the same as SECONDARY.)
 314 */
 315        (selection))
 316 {
 317   CHECK_SYMBOL (selection);
 318   if      (EQ (selection, Qnil)) selection = QPRIMARY;
 319   else if (EQ (selection, Qt))   selection = QSECONDARY;
 320
 321   return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt;
 322 }
 323
 324 DEFUN ("selection-exists-p", Fselection_exists_p, 0, 2, 0, /*
 325 Whether there is an owner for the given Selection.
 326 The arg should be the name of the selection in question, typically one of
 327 the symbols PRIMARY, SECONDARY, or CLIPBOARD.  (For convenience, the symbol
 328 nil is the same as PRIMARY, and t is the same as SECONDARY.)
 329 */
 330        (selection, device))
 331 {
 332   CHECK_SYMBOL (selection);
 333   if (!NILP (Fselection_owner_p (selection)))
 334     return Qt;
 335
 336   if (NILP (device))
 337     device = Fselected_device (Qnil);
 338
 339   return HAS_DEVMETH_P (XDEVICE (device), selection_exists_p) ?
 340     DEVMETH (XDEVICE (device), selection_exists_p, (selection))
 341     : Qnil;
 342 }
 343
 344 /* Request the selection value from the owner.  If we are the owner,
 345    simply return our selection value.  If we are not the owner, this
 346    will block until all of the data has arrived.
 347  */
 348 DEFUN ("get-selection-internal", Fget_selection_internal, 2, 3, 0, /*
 349 Return text selected from some window-system window.
 350 SELECTION_SYMBOL is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
 351 TARGET_TYPE is the type of data desired, typically STRING or COMPOUND_TEXT.
 352 Under Mule, if the resultant data comes back as 8-bit data in type
 353 TEXT or COMPOUND_TEXT, it will be decoded as Compound Text.
 354 */
 355        (selection_symbol, target_type, device))
 356 {
 357   /* This function can GC */
 358   Lisp_Object val = Qnil;
 359   struct gcpro gcpro1, gcpro2;
 360   GCPRO2 (target_type, val); /* we store newly consed data into these */
 361   CHECK_SYMBOL (selection_symbol);
 362
 363   if (NILP (device))
 364     device = Fselected_device (Qnil);
 365
 366 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
 367   if (CONSP (target_type) &&
 368       XCAR (target_type) == QMULTIPLE)
 369     {
 370       CHECK_VECTOR (XCDR (target_type));
 371       /* So we don't destructively modify this... */
 372       target_type = copy_multiple_data (target_type);
 373     }
 374   else
 375 #endif
 376     CHECK_SYMBOL (target_type);
 377
 378   val = get_local_selection (selection_symbol, target_type);
 379
 380   if (NILP (val) && (HAS_DEVMETH_P (XDEVICE (device), get_foreign_selection)))
 381     {
 382       val = DEVMETH (XDEVICE (device), get_foreign_selection,
 383                      (selection_symbol, target_type));
 384     }
 385   else
 386     {
 387       if (CONSP (val) && SYMBOLP (XCAR (val)))
 388         {
 389           val = XCDR (val);
 390           if (CONSP (val) && NILP (XCDR (val)))
 391             val = XCAR (val);
 392         }
 393       val = clean_local_selection_data (val);
 394     }
 395   UNGCPRO;
 396   return val;
 397 }
 398
 399 void
 400 syms_of_select (void)
 401 {
 402   DEFSUBR (Fown_selection_internal);
 403   DEFSUBR (Fget_selection_internal);
 404   DEFSUBR (Fselection_exists_p);
 405   DEFSUBR (Fdisown_selection_internal);
 406   DEFSUBR (Fselection_owner_p);
 407
 408   defsymbol (&QPRIMARY, "PRIMARY");
 409   defsymbol (&QSECONDARY, "SECONDARY");
 410   defsymbol (&QSTRING, "STRING");
 411   defsymbol (&QINTEGER, "INTEGER");
 412   defsymbol (&QCLIPBOARD, "CLIPBOARD");
 413   defsymbol (&QTIMESTAMP, "TIMESTAMP");
 414   defsymbol (&QTEXT, "TEXT");
 415   defsymbol (&QDELETE, "DELETE");
 416   defsymbol (&QMULTIPLE, "MULTIPLE");
 417   defsymbol (&QINCR, "INCR");
 418   defsymbol (&QEMACS_TMP, "_EMACS_TMP_");
 419   defsymbol (&QTARGETS, "TARGETS");
 420   defsymbol (&QATOM, "ATOM");
 421   defsymbol (&QATOM_PAIR, "ATOM_PAIR");
 422   defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT");
 423   defsymbol (&QNULL, "NULL");
 424
 425   deferror (&Qselection_conversion_error,
 426             "selection-conversion-error",
 427             "selection-conversion error", Qio_error);
 428 }
 429
 430 void
 431 vars_of_select (void)
 432 {
 433   Vselection_alist = Qnil;
 434   staticpro (&Vselection_alist);
 435
 436   DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist /*
 437 An alist associating selection-types (such as STRING and TIMESTAMP) with
 438 functions.  These functions will be called with three args: the name
 439 of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a
 440 desired type to which the selection should be converted; and the local
 441 selection value (whatever had been passed to `own-selection').  For
 442 historical reasons these functions should return the value to send to
 443 an X server, which should be one of:
 444
 445 -- nil (the conversion could not be done)
 446 -- a cons of a symbol and any of the following values; the symbol
 447    explicitly specifies the type that will be sent.
 448 -- a string (If the type is not specified, then if Mule support exists,
 449              the string will be converted to Compound Text and sent in
 450              the 'COMPOUND_TEXT format; otherwise (no Mule support),
 451              the string will be left as-is and sent in the 'STRING
 452              format.  If the type is specified, the string will be
 453              left as-is (or converted to binary format under Mule).
 454              In all cases, 8-bit data it sent.)
 455 -- a character (With Mule support, will be converted to Compound Text
 456                 whether or not a type is specified.  If a type is not
 457                 specified, a type of 'STRING or 'COMPOUND_TEXT will be
 458                 sent, as for strings.)
 459 -- the symbol 'NULL (Indicates that there is no meaningful return value.
 460                      Empty 32-bit data with a type of 'NULL will be sent.)
 461 -- a symbol (Will be converted into an atom.  If the type is not specified,
 462              a type of 'ATOM will be sent.)
 463 -- an integer (Will be converted into a 16-bit or 32-bit integer depending
 464                on the value.  If the type is not specified, a type of
 465                'INTEGER will be sent.)
 466 -- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer.
 467                                     If the type is not specified, a type of
 468                                     'INTEGER will be sent.)
 469 -- a vector of symbols (Will be converted into a list of atoms.  If the type
 470                         is not specified, a type of 'ATOM will be sent.)
 471 -- a vector of integers (Will be converted into a list of 16-bit integers.
 472                          If the type is not specified, a type of 'INTEGER
 473                          will be sent.)
 474 -- a vector of integers and/or conses (HIGH . LOW) of integers
 475                         (Will be converted into a list of 16-bit integers.
 476                          If the type is not specified, a type of 'INTEGER
 477                          will be sent.)  */ );
 478   Vselection_converter_alist = Qnil;
 479
 480   DEFVAR_LISP ("lost-selection-hooks", &Vlost_selection_hooks /*
 481 A function or functions to be called after we have been notified
 482 that we have lost the selection.  The function(s) will be called with one
 483 argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or
 484 CLIPBOARD).
 485 */ );
 486   Vlost_selection_hooks = Qunbound;
 487 }
 488