annotate lisp/select.el @ 2420:c61190e101a0

Removed author and Adapted-By lines. They're wrong, and they're not in the supposedly up-to-date version on my system. What was going on here?
author Eric S. Raymond <esr@snark.thyrsus.com>
date Mon, 29 Mar 1993 15:48:02 +0000
parents 53ce64806d58
children b65cf676a09b
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2234
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
1 ;;; select.el --- lisp portion of standard selection support.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
2
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
3 ;; Keywords: internal
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
4
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
5 ;; Copyright (c) 1993 Free Software Foundation, Inc.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
6 ;; Based partially on earlier release by Lucid.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
7
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
9
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
13 ;; any later version.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
14
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
18 ;; GNU General Public License for more details.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
19
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
23
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
24 ;;; Code:
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
25
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
26 ;; This is for temporary compatibility with pre-release Emacs 19.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
27 (fset 'x-selection 'x-get-selection)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
28 (defun x-get-selection (&optional type data-type)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
29 "Return the value of an X Windows selection.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
30 The argument TYPE (default `PRIMARY') says which selection,
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
31 and the argument DATA-TYPE (default `STRING') says how to convert the data."
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
32 (x-get-selection-internal (or type 'PRIMARY) (or data-type 'STRING)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
33
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
34 (defun x-get-clipboard ()
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
35 "Return text pasted to the clipboard."
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
36 (x-get-selection-internal 'CLIPBOARD 'STRING))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
37
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
38 (defun x-set-selection (type data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
39 "Make an X Windows selection of type TYPE and value DATA.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
40 The argument TYPE (default `PRIMARY') says which selection,
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
41 and DATA specifies the contents. DATA may be a string,
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
42 a symbol, an integer (or a cons of two integers or list of two integers),
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
43 or a cons of two markers pointing to the same buffer.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
44 In the last case, the selection is considered to be the text
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
45 between the markers.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
46 The data may also be a vector of valid non-vector selection values."
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
47 (interactive (if (not current-prefix-arg)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
48 (list (read-string "Store text for pasting: "))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
49 (list (cons ;; these need not be ordered.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
50 (copy-marker (point-marker))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
51 (copy-marker (mark-marker))))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
52 ;; This is for temporary compatibility with pre-release Emacs 19.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
53 (if (stringp type)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
54 (setq type (intern type)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
55 (or (x-valid-simple-selection-p data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
56 (and (vectorp data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
57 (let ((valid t)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
58 (i (1- (length data))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
59 (while (>= i 0)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
60 (or (x-valid-simple-selection-p (aref data i))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
61 (setq valid nil))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
62 (setq i (1- i)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
63 valid))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
64 (signal 'error (list "invalid selection" data)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
65 (or type (setq type 'PRIMARY))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
66 (if data
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
67 (x-own-selection-internal type data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
68 (x-disown-selection-internal type))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
69 data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
70
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
71 (defun x-valid-simple-selection-p (data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
72 (or (stringp data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
73 (symbolp data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
74 (integerp data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
75 (and (consp data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
76 (integerp (car data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
77 (or (integerp (cdr data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
78 (and (consp (cdr data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
79 (integerp (car (cdr data))))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
80 ;;; (and (fboundp 'extentp)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
81 ;;; (extentp data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
82 (and (consp data)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
83 (markerp (car data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
84 (markerp (cdr data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
85 (marker-buffer (car data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
86 (marker-buffer (cdr data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
87 (eq (marker-buffer (car data))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
88 (marker-buffer (cdr data)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
89 (buffer-name (marker-buffer (car data)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
90 (buffer-name (marker-buffer (cdr data))))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
91
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
92 ;;; Cut Buffer support
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
93
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
94 (defun x-get-cut-buffer (&optional which-one)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
95 "Returns the value of one of the 8 X server cut-buffers. Optional arg
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
96 WHICH-ONE should be a number from 0 to 7, defaulting to 0.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
97 Cut buffers are considered obsolete; you should use selections instead."
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
98 (x-get-cut-buffer-internal
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
99 (if which-one
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
100 (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
101 CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7]
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
102 which-one)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
103 'CUT_BUFFER0)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
104
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
105 (defun x-set-cut-buffer (string)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
106 "Store STRING into the X server's primary cut buffer.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
107 The previous value of the primary cut buffer is rotated to the secondary
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
108 cut buffer, and the second to the third, and so on (there are 8 buffers.)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
109 Cut buffers are considered obsolete; you should use selections instead."
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
110 ;; Check the data type of STRING.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
111 (substring string 0 0)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
112 (x-rotate-cut-buffers-internal 1)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
113 (x-store-cut-buffer-internal 'CUT_BUFFER0 string))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
114
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
115
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
116 ;;; Functions to convert the selection into various other selection types.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
117 ;;; Every selection type that Emacs handles is implemented this way, except
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
118 ;;; for TIMESTAMP, which is a special case.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
119
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
120 (defun xselect-convert-to-string (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
121 (cond ((stringp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
122 value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
123 ;;; ((extentp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
124 ;;; (save-excursion
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
125 ;;; (set-buffer (extent-buffer value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
126 ;;; (buffer-substring (extent-start-position value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
127 ;;; (extent-end-position value))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
128 ((and (consp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
129 (markerp (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
130 (markerp (cdr value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
131 (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
132 (signal 'error
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
133 (list "markers must be in the same buffer"
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
134 (car value) (cdr value))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
135 (save-excursion
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
136 (set-buffer (or (marker-buffer (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
137 (error "selection is in a killed buffer")))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
138 (buffer-substring (car value) (cdr value))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
139 (t nil)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
140
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
141 (defun xselect-convert-to-length (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
142 (let ((value
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
143 (cond ((stringp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
144 (length value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
145 ;;; ((extentp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
146 ;;; (extent-length value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
147 ((and (consp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
148 (markerp (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
149 (markerp (cdr value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
150 (or (eq (marker-buffer (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
151 (marker-buffer (cdr value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
152 (signal 'error
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
153 (list "markers must be in the same buffer"
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
154 (car value) (cdr value))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
155 (abs (- (car value) (cdr value)))))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
156 (if value ; force it to be in 32-bit format.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
157 (cons (ash value -16) (logand value 65535))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
158 nil)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
159
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
160 (defun xselect-convert-to-targets (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
161 ;; return a vector of atoms, but remove duplicates first.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
162 (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
163 (rest all))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
164 (while rest
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
165 (cond ((memq (car rest) (cdr rest))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
166 (setcdr rest (delq (car rest) (cdr rest))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
167 ((eq (car (cdr rest)) '_EMACS_INTERNAL) ; shh, it's a secret
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
168 (setcdr rest (cdr (cdr rest))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
169 (t
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
170 (setq rest (cdr rest)))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
171 (apply 'vector all)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
172
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
173 (defun xselect-convert-to-delete (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
174 (x-disown-selection-internal selection)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
175 ;; A return value of nil means that we do not know how to do this conversion,
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
176 ;; and replies with an "error". A return value of NULL means that we have
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
177 ;; done the conversion (and any side-effects) but have no value to return.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
178 'NULL)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
179
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
180 (defun xselect-convert-to-filename (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
181 (cond
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
182 ;;; ((extentp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
183 ;;; (buffer-file-name (or (extent-buffer value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
184 ;;; (error "selection is in a killed buffer"))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
185 ((and (consp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
186 (markerp (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
187 (markerp (cdr value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
188 (buffer-file-name (or (marker-buffer (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
189 (error "selection is in a killed buffer"))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
190 (t nil)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
191
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
192 (defun xselect-convert-to-charpos (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
193 (let (a b tmp)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
194 (cond ((cond
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
195 ;;; ((extentp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
196 ;;; (setq a (extent-start-position value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
197 ;;; b (extent-end-position value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
198 ((and (consp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
199 (markerp (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
200 (markerp (cdr value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
201 (setq a (car value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
202 b (cdr value))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
203 (setq a (1- a) b (1- b)) ; zero-based
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
204 (if (< b a) (setq tmp a a b b tmp))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
205 (cons 'SPAN
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
206 (vector (cons (ash a -16) (logand a 65535))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
207 (cons (ash b -16) (logand b 65535))))))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
208
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
209 (defun xselect-convert-to-lineno (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
210 (let (a b buf tmp)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
211 (cond ((cond ((and (consp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
212 (markerp (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
213 (markerp (cdr value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
214 (setq a (marker-position (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
215 b (marker-position (cdr value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
216 buf (marker-buffer (car value))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
217 ;;; ((extentp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
218 ;;; (setq buf (extent-buffer value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
219 ;;; a (extent-start-position value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
220 ;;; b (extent-end-position value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
221 )
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
222 (save-excursion
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
223 (set-buffer buf)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
224 (setq a (count-lines 1 a)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
225 b (count-lines 1 b)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
226 (if (< b a) (setq tmp a a b b tmp))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
227 (cons 'SPAN
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
228 (vector (cons (ash a -16) (logand a 65535))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
229 (cons (ash b -16) (logand b 65535))))))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
230
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
231 (defun xselect-convert-to-colno (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
232 (let (a b buf tmp)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
233 (cond ((cond ((and (consp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
234 (markerp (car value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
235 (markerp (cdr value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
236 (setq a (car value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
237 b (cdr value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
238 buf (marker-buffer a)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
239 ;;; ((extentp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
240 ;;; (setq buf (extent-buffer value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
241 ;;; a (extent-start-position value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
242 ;;; b (extent-end-position value)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
243 )
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
244 (save-excursion
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
245 (set-buffer buf)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
246 (goto-char a)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
247 (setq a (current-column))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
248 (goto-char b)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
249 (setq b (current-column)))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
250 (if (< b a) (setq tmp a a b b tmp))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
251 (cons 'SPAN
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
252 (vector (cons (ash a -16) (logand a 65535))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
253 (cons (ash b -16) (logand b 65535))))))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
254
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
255 (defun xselect-convert-to-os (selection type size)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
256 (symbol-name system-type))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
257
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
258 (defun xselect-convert-to-host (selection type size)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
259 (system-name))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
260
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
261 (defun xselect-convert-to-user (selection type size)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
262 (user-full-name))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
263
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
264 (defun xselect-convert-to-class (selection type size)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
265 x-emacs-application-class)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
266
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
267 ;; We do not try to determine the name Emacs was invoked with,
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
268 ;; because it is not clean for a program's behavior to depend on that.
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
269 (defun xselect-convert-to-name (selection type size)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
270 "emacs")
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
271
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
272 (defun xselect-convert-to-integer (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
273 (and (integerp value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
274 (cons (ash value -16) (logand value 65535))))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
275
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
276 (defun xselect-convert-to-atom (selection type value)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
277 (and (symbolp value) value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
278
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
279 (defun xselect-convert-to-identity (selection type value) ; used internally
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
280 (vector value))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
281
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
282 (setq selection-converter-alist
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
283 '((TEXT . xselect-convert-to-string)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
284 (STRING . xselect-convert-to-string)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
285 (TARGETS . xselect-convert-to-targets)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
286 (LENGTH . xselect-convert-to-length)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
287 (DELETE . xselect-convert-to-delete)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
288 (FILE_NAME . xselect-convert-to-filename)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
289 (CHARACTER_POSITION . xselect-convert-to-charpos)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
290 (LINE_NUMBER . xselect-convert-to-lineno)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
291 (COLUMN_NUMBER . xselect-convert-to-colno)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
292 (OWNER_OS . xselect-convert-to-os)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
293 (HOST_NAME . xselect-convert-to-host)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
294 (USER . xselect-convert-to-user)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
295 (CLASS . xselect-convert-to-class)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
296 (NAME . xselect-convert-to-name)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
297 (ATOM . xselect-convert-to-atom)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
298 (INTEGER . xselect-convert-to-integer)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
299 (_EMACS_INTERNAL . xselect-convert-to-identity)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
300 ))
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
301
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
302 (provide 'select)
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
303
53ce64806d58 Initial revision
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
diff changeset
304 ;;; select.el ends here.