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
|