LCOV - code coverage report
Current view: top level - lisp - select.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 0 215 0.0 %
Date: 2017-08-27 09:44:50 Functions: 0 29 0.0 %

          Line data    Source code
       1             : ;;; select.el --- lisp portion of standard selection support  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 1993-1994, 2001-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Maintainer: emacs-devel@gnu.org
       6             : ;; Keywords: internal
       7             : 
       8             : ;; This file is part of GNU Emacs.
       9             : 
      10             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      11             : ;; it under the terms of the GNU General Public License as published by
      12             : ;; the Free Software Foundation, either version 3 of the License, or
      13             : ;; (at your option) any later version.
      14             : 
      15             : ;; GNU Emacs is distributed in the hope that it will be useful,
      16             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      17             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      18             : ;; GNU General Public License for more details.
      19             : 
      20             : ;; You should have received a copy of the GNU General Public License
      21             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      22             : 
      23             : ;;; Commentary:
      24             : 
      25             : ;; Based partially on earlier release by Lucid.
      26             : 
      27             : ;; The functionality here is divided in two parts:
      28             : ;; - Low-level: gui-get-selection, gui-set-selection, gui-selection-owner-p,
      29             : ;;   gui-selection-exists-p are the backend-dependent functions meant to access
      30             : ;;   various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY).
      31             : ;; - Higher-level: gui-select-text and gui-selection-value go together to
      32             : ;;   access the general notion of "GUI selection" for interoperation with other
      33             : ;;   applications.  This can use either the clipboard or the primary selection,
      34             : ;;   or both or none according to select-enable-clipboard/primary.  These are
      35             : ;;   the default values of interprogram-cut/paste-function.
      36             : ;;   Additionally, there's gui-get-primary-selection which is used to get the
      37             : ;;   PRIMARY selection, specifically for mouse-yank-primary.
      38             : 
      39             : ;;; Code:
      40             : 
      41             : (defcustom selection-coding-system nil
      42             :   "Coding system for communicating with other programs.
      43             : 
      44             : For MS-Windows and MS-DOS:
      45             : When sending or receiving text via selection and clipboard, the text
      46             : is encoded or decoded by this coding system.  The default value is
      47             : the current system default encoding on 9x/Me, `utf-16le-dos'
      48             : \(Unicode) on NT/W2K/XP, and `iso-latin-1-dos' on MS-DOS.
      49             : 
      50             : For X Windows:
      51             : When sending text via selection and clipboard, if the target
      52             : data-type matches with the type of this coding system, it is used
      53             : for encoding the text.  Otherwise (including the case that this
      54             : variable is nil), a proper coding system is used as below:
      55             : 
      56             : data-type       coding system
      57             : ---------       -------------
      58             : UTF8_STRING     utf-8
      59             : COMPOUND_TEXT   compound-text-with-extensions
      60             : STRING          iso-latin-1
      61             : C_STRING        no-conversion
      62             : 
      63             : When receiving text, if this coding system is non-nil, it is used
      64             : for decoding regardless of the data-type.  If this is nil, a
      65             : proper coding system is used according to the data-type as above.
      66             : 
      67             : See also the documentation of the variable `x-select-request-type' how
      68             : to control which data-type to request for receiving text.
      69             : 
      70             : The default value is nil."
      71             :   :type 'coding-system
      72             :   :group 'mule
      73             :   ;; Default was compound-text-with-extensions in 22.x (pre-unicode).
      74             :   :version "23.1"
      75             :   :set (lambda (symbol value)
      76             :          (set-selection-coding-system value)
      77             :          (set symbol value)))
      78             : 
      79             : (defvar next-selection-coding-system nil
      80             :   "Coding system for the next communication with other programs.
      81             : Usually, `selection-coding-system' is used for communicating with
      82             : other programs (X Windows clients or MS Windows programs).  But, if this
      83             : variable is set, it is used for the next communication only.
      84             : After the communication, this variable is set to nil.")
      85             : 
      86             : ;; Only declared obsolete in 23.3.
      87             : (define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34")
      88             : 
      89             : (defcustom select-enable-clipboard t
      90             :   "Non-nil means cutting and pasting uses the clipboard.
      91             : This can be in addition to, but in preference to, the primary selection,
      92             : if applicable (i.e. under X11)."
      93             :   :type 'boolean
      94             :   :group 'killing
      95             :   ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not.
      96             :   :version "24.1")
      97             : (define-obsolete-variable-alias 'x-select-enable-clipboard
      98             :   'select-enable-clipboard "25.1")
      99             : 
     100             : (defcustom select-enable-primary nil
     101             :   "Non-nil means cutting and pasting uses the primary selection
     102             : The existence of a primary selection depends on the underlying GUI you use.
     103             : E.g. it doesn't exist under MS-Windows."
     104             :   :type 'boolean
     105             :   :group 'killing
     106             :   :version "25.1")
     107             : (define-obsolete-variable-alias 'x-select-enable-primary
     108             :   'select-enable-primary "25.1")
     109             : 
     110             : ;; We keep track of the last text selected here, so we can check the
     111             : ;; current selection against it, and avoid passing back our own text
     112             : ;; from gui-selection-value.  We track both
     113             : ;; separately in case another X application only sets one of them
     114             : ;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same.
     115             : 
     116             : (defvar gui--last-selected-text-clipboard nil
     117             :   "The value of the CLIPBOARD selection last seen.")
     118             : (defvar gui--last-selected-text-primary nil
     119             :   "The value of the PRIMARY selection last seen.")
     120             : 
     121             : (defun gui-select-text (text)
     122             :   "Select TEXT, a string, according to the window system.
     123             : if `select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard.
     124             : If `select-enable-primary' is non-nil, put TEXT in the primary selection.
     125             : 
     126             : MS-Windows does not have a \"primary\" selection."
     127           0 :   (when select-enable-primary
     128           0 :     (gui-set-selection 'PRIMARY text)
     129           0 :     (setq gui--last-selected-text-primary text))
     130           0 :   (when select-enable-clipboard
     131             :     ;; When cutting, the selection is cleared and PRIMARY
     132             :     ;; set to the empty string.  Prevent that, PRIMARY
     133             :     ;; should not be reset by cut (Bug#16382).
     134           0 :     (setq saved-region-selection text)
     135           0 :     (gui-set-selection 'CLIPBOARD text)
     136           0 :     (setq gui--last-selected-text-clipboard text)))
     137             : (define-obsolete-function-alias 'x-select-text 'gui-select-text "25.1")
     138             : 
     139             : (defcustom x-select-request-type nil
     140             :   "Data type request for X selection.
     141             : The value is one of the following data types, a list of them, or nil:
     142             :   `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT'
     143             : 
     144             : If the value is one of the above symbols, try only the specified type.
     145             : 
     146             : If the value is a list of them, try each of them in the specified
     147             : order until succeed.
     148             : 
     149             : The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
     150             :   :type '(choice (const :tag "Default" nil)
     151             :                  (const COMPOUND_TEXT)
     152             :                  (const UTF8_STRING)
     153             :                  (const STRING)
     154             :                  (const TEXT)
     155             :                  (set :tag "List of values"
     156             :                       (const COMPOUND_TEXT)
     157             :                       (const UTF8_STRING)
     158             :                       (const STRING)
     159             :                       (const TEXT)))
     160             :   :group 'killing)
     161             : 
     162             : ;; Get a selection value of type TYPE by calling gui-get-selection with
     163             : ;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
     164             : ;; The return value is already decoded.  If gui-get-selection causes an
     165             : ;; error, this function return nil.
     166             : 
     167             : (defun gui--selection-value-internal (type)
     168           0 :   (let ((request-type (if (eq window-system 'x)
     169           0 :                           (or x-select-request-type
     170           0 :                               '(UTF8_STRING COMPOUND_TEXT STRING))
     171           0 :                         'STRING))
     172             :         text)
     173           0 :     (with-demoted-errors "gui-get-selection: %S"
     174           0 :       (if (consp request-type)
     175           0 :           (while (and request-type (not text))
     176           0 :             (setq text (gui-get-selection type (car request-type)))
     177           0 :             (setq request-type (cdr request-type)))
     178           0 :         (setq text (gui-get-selection type request-type))))
     179           0 :     (if text
     180           0 :         (remove-text-properties 0 (length text) '(foreign-selection nil) text))
     181           0 :     text))
     182             : 
     183             : (defun gui-selection-value ()
     184           0 :   (let ((clip-text
     185           0 :          (when select-enable-clipboard
     186           0 :            (let ((text (gui--selection-value-internal 'CLIPBOARD)))
     187           0 :              (if (string= text "") (setq text nil))
     188             : 
     189             :              ;; Check the CLIPBOARD selection for 'newness', is it different
     190             :              ;; from what we remembered them to be last time we did a
     191             :              ;; cut/paste operation.
     192           0 :              (prog1
     193           0 :                  (unless (equal text gui--last-selected-text-clipboard)
     194           0 :                    text)
     195           0 :                (setq gui--last-selected-text-clipboard text)))))
     196             :         (primary-text
     197           0 :          (when select-enable-primary
     198           0 :            (let ((text (gui--selection-value-internal 'PRIMARY)))
     199           0 :              (if (string= text "") (setq text nil))
     200             :              ;; Check the PRIMARY selection for 'newness', is it different
     201             :              ;; from what we remembered them to be last time we did a
     202             :              ;; cut/paste operation.
     203           0 :              (prog1
     204           0 :                  (unless (equal text gui--last-selected-text-primary)
     205           0 :                    text)
     206           0 :                (setq gui--last-selected-text-primary text))))))
     207             : 
     208             :     ;; As we have done one selection, clear this now.
     209           0 :     (setq next-selection-coding-system nil)
     210             : 
     211             :     ;; At this point we have recorded the current values for the
     212             :     ;; selection from clipboard (if we are supposed to) and primary.
     213             :     ;; So return the first one that has changed
     214             :     ;; (which is the first non-null one).
     215             :     ;;
     216             :     ;; NOTE: There will be cases where more than one of these has
     217             :     ;; changed and the new values differ.  This indicates that
     218             :     ;; something like the following has happened since the last time
     219             :     ;; we looked at the selections: Application X set all the
     220             :     ;; selections, then Application Y set only one of them.
     221             :     ;; In this case since we don't have
     222             :     ;; timestamps there is no way to know what the 'correct' value to
     223             :     ;; return is.  The nice thing to do would be to tell the user we
     224             :     ;; saw multiple possible selections and ask the user which was the
     225             :     ;; one they wanted.
     226           0 :     (or clip-text primary-text)
     227           0 :     ))
     228             : 
     229             : (define-obsolete-function-alias 'x-selection-value 'gui-selection-value "25.1")
     230             : 
     231             : (defun x-get-clipboard ()
     232             :   "Return text pasted to the clipboard."
     233             :   (declare (obsolete gui-get-selection "25.1"))
     234           0 :   (gui-backend-get-selection 'CLIPBOARD 'STRING))
     235             : 
     236             : (defun gui-get-primary-selection ()
     237             :   "Return the PRIMARY selection, or the best emulation thereof."
     238           0 :   (or (gui--selection-value-internal 'PRIMARY)
     239           0 :       (and (fboundp 'w32-get-selection-value)
     240           0 :            (eq (framep (selected-frame)) 'w32)
     241             :            ;; MS-Windows emulates PRIMARY in x-get-selection, but only
     242             :            ;; within the Emacs session, so consult the clipboard if
     243             :            ;; primary is not found.
     244           0 :            (w32-get-selection-value))
     245           0 :       (error "No selection is available")))
     246             : (define-obsolete-function-alias 'x-get-selection-value
     247             :   'gui-get-primary-selection "25.1")
     248             : 
     249             : ;;; Lower-level, backend dependent selection handling.
     250             : 
     251             : (cl-defgeneric gui-backend-get-selection (_selection-symbol _target-type)
     252             :   "Return selected text.
     253             : SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
     254             : \(Those are literal upper-case symbol names, since that's what X expects.)
     255             : TARGET-TYPE is the type of data desired, typically `STRING'."
     256             :   nil)
     257             : 
     258             : (cl-defgeneric gui-backend-set-selection (_selection _value)
     259             :   "Method to assert a selection of type SELECTION and value VALUE.
     260             : SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
     261             : If VALUE is nil and we own the selection SELECTION, disown it instead.
     262             : Disowning it means there is no such selection.
     263             : \(Those are literal upper-case symbol names, since that's what X expects.)
     264             : VALUE is typically a string, or a cons of two markers, but may be
     265             : anything that the functions on `selection-converter-alist' know about."
     266             :   nil)
     267             : 
     268             : (cl-defgeneric gui-backend-selection-owner-p (_selection)
     269             :   "Whether the current Emacs process owns the given X Selection.
     270             : The arg should be the name of the selection in question, typically one of
     271             : the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
     272             : \(Those are literal upper-case symbol names, since that's what X expects.)"
     273             :   nil)
     274             : 
     275             : (cl-defgeneric gui-backend-selection-exists-p (_selection)
     276             :   "Whether there is an owner for the given X Selection.
     277             : The arg should be the name of the selection in question, typically one of
     278             : the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
     279             : \(Those are literal upper-case symbol names, since that's what X expects.)"
     280             :   nil)
     281             : 
     282             : (defun gui-get-selection (&optional type data-type)
     283             :   "Return the value of an X Windows selection.
     284             : The argument TYPE (default `PRIMARY') says which selection,
     285             : and the argument DATA-TYPE (default `STRING') says
     286             : how to convert the data.
     287             : 
     288             : TYPE may be any symbol \(but nil stands for `PRIMARY').  However,
     289             : only a few symbols are commonly used.  They conventionally have
     290             : all upper-case names.  The most often used ones, in addition to
     291             : `PRIMARY', are `SECONDARY' and `CLIPBOARD'.
     292             : 
     293             : DATA-TYPE is usually `STRING', but can also be one of the symbols
     294             : in `selection-converter-alist', which see.  This argument is
     295             : ignored on NS, MS-Windows and MS-DOS."
     296           0 :   (let ((data (gui-backend-get-selection (or type 'PRIMARY)
     297           0 :                                          (or data-type 'STRING))))
     298           0 :     (when (and (stringp data)
     299           0 :                (setq data-type (get-text-property 0 'foreign-selection data)))
     300           0 :       (let ((coding (or next-selection-coding-system
     301           0 :                         selection-coding-system
     302           0 :                         (pcase data-type
     303             :                           ('UTF8_STRING 'utf-8)
     304             :                           ('COMPOUND_TEXT 'compound-text-with-extensions)
     305             :                           ('C_STRING nil)
     306             :                           ('STRING 'iso-8859-1)
     307           0 :                           (_ (error "Unknown selection data type: %S"
     308           0 :                                     type))))))
     309           0 :         (setq data (if coding (decode-coding-string data coding)
     310           0 :                      (string-to-multibyte data))))
     311           0 :       (setq next-selection-coding-system nil)
     312           0 :       (put-text-property 0 (length data) 'foreign-selection data-type data))
     313           0 :     data))
     314             : (define-obsolete-function-alias 'x-get-selection 'gui-get-selection "25.1")
     315             : 
     316             : (defun gui-set-selection (type data)
     317             :   "Make an X selection of type TYPE and value DATA.
     318             : The argument TYPE (nil means `PRIMARY') says which selection, and
     319             : DATA specifies the contents.  TYPE must be a symbol.  \(It can also
     320             : be a string, which stands for the symbol with that name, but this
     321             : is considered obsolete.)  DATA may be a string, a symbol, an
     322             : integer (or a cons of two integers or list of two integers).
     323             : 
     324             : The selection may also be a cons of two markers pointing to the same buffer,
     325             : or an overlay.  In these cases, the selection is considered to be the text
     326             : between the markers *at whatever time the selection is examined*.
     327             : Thus, editing done in the buffer after you specify the selection
     328             : can alter the effective value of the selection.
     329             : 
     330             : The data may also be a vector of valid non-vector selection values.
     331             : 
     332             : The return value is DATA.
     333             : 
     334             : Interactively, this command sets the primary selection.  Without
     335             : prefix argument, it reads the selection in the minibuffer.  With
     336             : prefix argument, it uses the text of the region as the selection value.
     337             : 
     338             : Note that on MS-Windows, primary and secondary selections set by Emacs
     339             : are not available to other programs."
     340           0 :   (interactive (if (not current-prefix-arg)
     341           0 :                    (list 'PRIMARY (read-string "Set text for pasting: "))
     342           0 :                  (list 'PRIMARY (buffer-substring (region-beginning) (region-end)))))
     343           0 :   (if (stringp type) (setq type (intern type)))
     344           0 :   (or (gui--valid-simple-selection-p data)
     345           0 :       (and (vectorp data)
     346           0 :            (let ((valid t))
     347           0 :              (dotimes (i (length data))
     348           0 :                (or (gui--valid-simple-selection-p (aref data i))
     349           0 :                    (setq valid nil)))
     350           0 :              valid))
     351           0 :       (signal 'error (list "invalid selection" data)))
     352           0 :   (or type (setq type 'PRIMARY))
     353           0 :   (gui-backend-set-selection type data)
     354           0 :   data)
     355             : (define-obsolete-function-alias 'x-set-selection 'gui-set-selection "25.1")
     356             : 
     357             : (defun gui--valid-simple-selection-p (data)
     358           0 :   (or (bufferp data)
     359           0 :       (and (consp data)
     360           0 :            (markerp (car data))
     361           0 :            (markerp (cdr data))
     362           0 :            (marker-buffer (car data))
     363           0 :            (buffer-live-p (marker-buffer (car data)))
     364           0 :            (eq (marker-buffer (car data))
     365           0 :                (marker-buffer (cdr data))))
     366           0 :       (stringp data)
     367           0 :       (and (overlayp data)
     368           0 :            (overlay-buffer data)
     369           0 :            (buffer-live-p (overlay-buffer data)))
     370           0 :       (symbolp data)
     371           0 :       (integerp data)))
     372             : 
     373             : ;; Functions to convert the selection into various other selection types.
     374             : ;; Every selection type that Emacs handles is implemented this way, except
     375             : ;; for TIMESTAMP, which is a special case.
     376             : 
     377             : (defun xselect--selection-bounds (value)
     378             :   "Return bounds of X selection value VALUE.
     379             : The return value is a list (BEG END BUF) if VALUE is a cons of
     380             : two markers or an overlay.  Otherwise, it is nil."
     381           0 :   (cond ((bufferp value)
     382           0 :          (with-current-buffer value
     383           0 :            (when (mark t)
     384           0 :              (list (mark t) (point) value))))
     385           0 :         ((and (consp value)
     386           0 :               (markerp (car value))
     387           0 :               (markerp (cdr value)))
     388           0 :          (when (and (marker-buffer (car value))
     389           0 :                     (buffer-name (marker-buffer (car value)))
     390           0 :                     (eq (marker-buffer (car value))
     391           0 :                         (marker-buffer (cdr value))))
     392           0 :            (list (marker-position (car value))
     393           0 :                  (marker-position (cdr value))
     394           0 :                  (marker-buffer (car value)))))
     395           0 :         ((overlayp value)
     396           0 :          (when (overlay-buffer value)
     397           0 :            (list (overlay-start value)
     398           0 :                  (overlay-end value)
     399           0 :                  (overlay-buffer value))))))
     400             : 
     401             : (defun xselect--int-to-cons (n)
     402           0 :   (cons (ash n -16) (logand n 65535)))
     403             : 
     404             : (defun xselect--encode-string (type str &optional can-modify)
     405           0 :   (when str
     406             :     ;; If TYPE is nil, this is a local request; return STR as-is.
     407           0 :     (if (null type)
     408           0 :         str
     409             :       ;; Otherwise, encode STR.
     410           0 :       (let ((coding (or next-selection-coding-system
     411           0 :                         selection-coding-system)))
     412           0 :         (if coding
     413           0 :             (setq coding (coding-system-base coding)))
     414           0 :         (let ((inhibit-read-only t))
     415             :           ;; Suppress producing escape sequences for compositions.
     416             :           ;; But avoid modifying the string if it's a buffer name etc.
     417           0 :           (unless can-modify (setq str (substring str 0)))
     418           0 :           (remove-text-properties 0 (length str) '(composition nil) str)
     419             :           ;; For X selections, TEXT is a polymorphic target; choose
     420             :           ;; the actual type from `UTF8_STRING', `COMPOUND_TEXT',
     421             :           ;; `STRING', and `C_STRING'.  On Nextstep, always use UTF-8
     422             :           ;; (see ns_string_to_pasteboard_internal in nsselect.m).
     423           0 :           (when (eq type 'TEXT)
     424           0 :             (cond
     425           0 :              ((featurep 'ns)
     426           0 :               (setq type 'UTF8_STRING))
     427           0 :              ((not (multibyte-string-p str))
     428           0 :               (setq type 'C_STRING))
     429             :              (t
     430           0 :               (let (non-latin-1 non-unicode eight-bit)
     431           0 :                 (mapc #'(lambda (x)
     432           0 :                           (if (>= x #x100)
     433           0 :                               (if (< x #x110000)
     434           0 :                                   (setq non-latin-1 t)
     435           0 :                                 (if (< x #x3FFF80)
     436           0 :                                     (setq non-unicode t)
     437           0 :                                   (setq eight-bit t)))))
     438           0 :                       str)
     439           0 :                 (setq type (if (or non-unicode
     440           0 :                                    (and
     441           0 :                                     non-latin-1
     442             :                                     ;; If a coding is specified for
     443             :                                     ;; selection, and that is
     444             :                                     ;; compatible with COMPOUND_TEXT,
     445             :                                     ;; use it.
     446           0 :                                     coding
     447           0 :                                     (eq (coding-system-get coding :mime-charset)
     448           0 :                                         'x-ctext)))
     449             :                                'COMPOUND_TEXT
     450           0 :                              (if non-latin-1 'UTF8_STRING
     451           0 :                                (if eight-bit 'C_STRING
     452           0 :                                  'STRING))))))))
     453           0 :           (cond
     454           0 :            ((eq type 'UTF8_STRING)
     455           0 :             (if (or (not coding)
     456           0 :                     (not (eq (coding-system-type coding) 'utf-8)))
     457           0 :                 (setq coding 'utf-8))
     458           0 :             (setq str (encode-coding-string str coding)))
     459             : 
     460           0 :            ((eq type 'STRING)
     461           0 :             (if (or (not coding)
     462           0 :                     (not (eq (coding-system-type coding) 'charset)))
     463           0 :                 (setq coding 'iso-8859-1))
     464           0 :             (setq str (encode-coding-string str coding)))
     465             : 
     466           0 :            ((eq type 'COMPOUND_TEXT)
     467           0 :             (if (or (not coding)
     468           0 :                     (not (eq (coding-system-type coding) 'iso-2022)))
     469           0 :                 (setq coding 'compound-text-with-extensions))
     470           0 :             (setq str (encode-coding-string str coding)))
     471             : 
     472           0 :            ((eq type 'C_STRING)
     473           0 :             (setq str (string-make-unibyte str)))
     474             : 
     475             :            (t
     476           0 :             (error "Unknown selection type: %S" type)))))
     477             : 
     478             :       ;; Most programs are unable to handle NUL bytes in strings.
     479           0 :       (setq str (replace-regexp-in-string "\0" "\\0" str t t))
     480             : 
     481           0 :       (setq next-selection-coding-system nil)
     482           0 :       (cons type str))))
     483             : 
     484             : (defun xselect-convert-to-string (_selection type value)
     485           0 :   (let ((str (cond ((stringp value) value)
     486           0 :                    ((setq value (xselect--selection-bounds value))
     487           0 :                     (with-current-buffer (nth 2 value)
     488           0 :                       (buffer-substring (nth 0 value)
     489           0 :                                         (nth 1 value)))))))
     490           0 :     (xselect--encode-string type str t)))
     491             : 
     492             : (defun xselect-convert-to-length (_selection _type value)
     493           0 :   (let ((len (cond ((stringp value)
     494           0 :                     (length value))
     495           0 :                    ((setq value (xselect--selection-bounds value))
     496           0 :                     (abs (- (nth 0 value) (nth 1 value)))))))
     497           0 :     (if len
     498           0 :         (xselect--int-to-cons len))))
     499             : 
     500             : (defun xselect-convert-to-targets (_selection _type _value)
     501             :   ;; return a vector of atoms, but remove duplicates first.
     502           0 :   (let* ((all (cons 'TIMESTAMP
     503           0 :                     (cons 'MULTIPLE
     504           0 :                           (mapcar 'car selection-converter-alist))))
     505           0 :          (rest all))
     506           0 :     (while rest
     507           0 :       (cond ((memq (car rest) (cdr rest))
     508           0 :              (setcdr rest (delq (car rest) (cdr rest))))
     509           0 :             ((eq (car (cdr rest)) '_EMACS_INTERNAL)  ; shh, it's a secret
     510           0 :              (setcdr rest (cdr (cdr rest))))
     511             :             (t
     512           0 :              (setq rest (cdr rest)))))
     513           0 :     (apply 'vector all)))
     514             : 
     515             : (defun xselect-convert-to-delete (selection _type _value)
     516           0 :   (gui-backend-set-selection selection nil)
     517             :   ;; A return value of nil means that we do not know how to do this conversion,
     518             :   ;; and replies with an "error".  A return value of NULL means that we have
     519             :   ;; done the conversion (and any side-effects) but have no value to return.
     520             :   'NULL)
     521             : 
     522             : (defun xselect-convert-to-filename (_selection _type value)
     523           0 :   (when (setq value (xselect--selection-bounds value))
     524           0 :     (xselect--encode-string 'TEXT (buffer-file-name (nth 2 value)))))
     525             : 
     526             : (defun xselect-convert-to-charpos (_selection _type value)
     527           0 :   (when (setq value (xselect--selection-bounds value))
     528           0 :     (let ((beg (1- (nth 0 value))) ; zero-based
     529           0 :           (end (1- (nth 1 value))))
     530           0 :       (cons 'SPAN (vector (xselect--int-to-cons (min beg end))
     531           0 :                           (xselect--int-to-cons (max beg end)))))))
     532             : 
     533             : (defun xselect-convert-to-lineno (_selection _type value)
     534           0 :   (when (setq value (xselect--selection-bounds value))
     535           0 :     (with-current-buffer (nth 2 value)
     536           0 :       (let ((beg (line-number-at-pos (nth 0 value)))
     537           0 :             (end (line-number-at-pos (nth 1 value))))
     538           0 :         (cons 'SPAN (vector (xselect--int-to-cons (min beg end))
     539           0 :                             (xselect--int-to-cons (max beg end))))))))
     540             : 
     541             : (defun xselect-convert-to-colno (_selection _type value)
     542           0 :   (when (setq value (xselect--selection-bounds value))
     543           0 :     (with-current-buffer (nth 2 value)
     544           0 :       (let ((beg (progn (goto-char (nth 0 value)) (current-column)))
     545           0 :             (end (progn (goto-char (nth 1 value)) (current-column))))
     546           0 :         (cons 'SPAN (vector (xselect--int-to-cons (min beg end))
     547           0 :                             (xselect--int-to-cons (max beg end))))))))
     548             : 
     549             : (defun xselect-convert-to-os (_selection _type _size)
     550           0 :   (xselect--encode-string 'TEXT (symbol-name system-type)))
     551             : 
     552             : (defun xselect-convert-to-host (_selection _type _size)
     553           0 :   (xselect--encode-string 'TEXT (system-name)))
     554             : 
     555             : (defun xselect-convert-to-user (_selection _type _size)
     556           0 :   (xselect--encode-string 'TEXT (user-full-name)))
     557             : 
     558             : (defun xselect-convert-to-class (_selection _type _size)
     559             :   "Convert selection to class.
     560             : This function returns the string \"Emacs\"."
     561             :   "Emacs")
     562             : 
     563             : ;; We do not try to determine the name Emacs was invoked with,
     564             : ;; because it is not clean for a program's behavior to depend on that.
     565             : (defun xselect-convert-to-name (_selection _type _size)
     566             :   "Convert selection to name.
     567             : This function returns the string \"emacs\"."
     568             :   "emacs")
     569             : 
     570             : (defun xselect-convert-to-integer (_selection _type value)
     571           0 :   (and (integerp value)
     572           0 :        (xselect--int-to-cons value)))
     573             : 
     574             : (defun xselect-convert-to-atom (_selection _type value)
     575           0 :   (and (symbolp value) value))
     576             : 
     577             : (defun xselect-convert-to-identity (_selection _type value) ; used internally
     578           0 :   (vector value))
     579             : 
     580             : ;; Null target that tells clipboard managers we support SAVE_TARGETS
     581             : ;; (see freedesktop.org Clipboard Manager spec).
     582             : (defun xselect-convert-to-save-targets (selection _type _value)
     583           0 :   (when (eq selection 'CLIPBOARD)
     584           0 :     'NULL))
     585             : 
     586             : (setq selection-converter-alist
     587             :       '((TEXT . xselect-convert-to-string)
     588             :         (COMPOUND_TEXT . xselect-convert-to-string)
     589             :         (STRING . xselect-convert-to-string)
     590             :         (UTF8_STRING . xselect-convert-to-string)
     591             :         (TARGETS . xselect-convert-to-targets)
     592             :         (LENGTH . xselect-convert-to-length)
     593             :         (DELETE . xselect-convert-to-delete)
     594             :         (FILE_NAME . xselect-convert-to-filename)
     595             :         (CHARACTER_POSITION . xselect-convert-to-charpos)
     596             :         (LINE_NUMBER . xselect-convert-to-lineno)
     597             :         (COLUMN_NUMBER . xselect-convert-to-colno)
     598             :         (OWNER_OS . xselect-convert-to-os)
     599             :         (HOST_NAME . xselect-convert-to-host)
     600             :         (USER . xselect-convert-to-user)
     601             :         (CLASS . xselect-convert-to-class)
     602             :         (NAME . xselect-convert-to-name)
     603             :         (ATOM . xselect-convert-to-atom)
     604             :         (INTEGER . xselect-convert-to-integer)
     605             :         (SAVE_TARGETS . xselect-convert-to-save-targets)
     606             :         (_EMACS_INTERNAL . xselect-convert-to-identity)))
     607             : 
     608             : (provide 'select)
     609             : 
     610             : ;;; select.el ends here

Generated by: LCOV version 1.12