31 |
(defalias 'x-selection 'x-get-selection) |
(defalias 'x-selection 'x-get-selection) |
32 |
(defun x-get-selection (&optional type data-type) |
(defun x-get-selection (&optional type data-type) |
33 |
"Return the value of an X Windows selection. |
"Return the value of an X Windows selection. |
34 |
The argument TYPE (default `PRIMARY') says which selection, |
The argument TYPE (default `PRIMARY') says which selection, |
35 |
and the argument DATA-TYPE (default `STRING') says |
and the argument DATA-TYPE (default `STRING') says |
36 |
how to convert the data. |
how to convert the data. |
37 |
|
|
46 |
|
|
47 |
(defun x-set-selection (type data) |
(defun x-set-selection (type data) |
48 |
"Make an X Windows selection of type TYPE and value DATA. |
"Make an X Windows selection of type TYPE and value DATA. |
49 |
The argument TYPE (default `PRIMARY') says which selection, |
The argument TYPE (default `PRIMARY') says which selection, |
50 |
and DATA specifies the contents. DATA may be a string, |
and DATA specifies the contents. DATA may be a string, |
51 |
a symbol, an integer (or a cons of two integers or list of two integers). |
a symbol, an integer (or a cons of two integers or list of two integers). |
52 |
|
|
53 |
The selection may also be a cons of two markers pointing to the same buffer, |
The selection may also be a cons of two markers pointing to the same buffer, |
54 |
or an overlay. In these cases, the selection is considered to be the text |
or an overlay. In these cases, the selection is considered to be the text |
55 |
between the markers *at whatever time the selection is examined*. |
between the markers *at whatever time the selection is examined*. |
56 |
Thus, editing done in the buffer after you specify the selection |
Thus, editing done in the buffer after you specify the selection |
57 |
can alter the effective value of the selection. |
can alter the effective value of the selection. |
118 |
(defun x-set-cut-buffer (string &optional push) |
(defun x-set-cut-buffer (string &optional push) |
119 |
"Store STRING into the X server's primary cut buffer. |
"Store STRING into the X server's primary cut buffer. |
120 |
If PUSH is non-nil, also rotate the cut buffers: |
If PUSH is non-nil, also rotate the cut buffers: |
121 |
this means the previous value of the primary cut buffer moves the second |
this means the previous value of the primary cut buffer moves to the second |
122 |
cut buffer, and the second to the third, and so on (there are 8 buffers.) |
cut buffer, and the second to the third, and so on (there are 8 buffers.) |
123 |
Cut buffers are considered obsolete; you should use selections instead." |
Cut buffers are considered obsolete; you should use selections instead." |
124 |
;; Check the data type of STRING. |
(or (stringp string) (signal 'wrong-type-argument (list 'string string))) |
|
(substring string 0 0) |
|
125 |
(if push |
(if push |
126 |
(x-rotate-cut-buffers-internal 1)) |
(x-rotate-cut-buffers-internal 1)) |
127 |
(x-store-cut-buffer-internal 'CUT_BUFFER0 string)) |
(x-store-cut-buffer-internal 'CUT_BUFFER0 string)) |
132 |
;;; for TIMESTAMP, which is a special case. |
;;; for TIMESTAMP, which is a special case. |
133 |
|
|
134 |
(defun xselect-convert-to-string (selection type value) |
(defun xselect-convert-to-string (selection type value) |
135 |
(cond ((stringp value) |
(let (str coding) |
136 |
;; Return the type as well, so that xselect.c could honor |
;; Get the actual string from VALUE. |
137 |
;; requests whose type is STRING. |
(cond ((stringp value) |
138 |
(cons type value)) |
(setq str value)) |
139 |
((overlayp value) |
|
140 |
(save-excursion |
((overlayp value) |
141 |
(or (buffer-name (overlay-buffer value)) |
(save-excursion |
142 |
(error "selection is in a killed buffer")) |
(or (buffer-name (overlay-buffer value)) |
143 |
(set-buffer (overlay-buffer value)) |
(error "selection is in a killed buffer")) |
144 |
(buffer-substring (overlay-start value) |
(set-buffer (overlay-buffer value)) |
145 |
(overlay-end value)))) |
(setq str (buffer-substring (overlay-start value) |
146 |
((and (consp value) |
(overlay-end value))))) |
147 |
(markerp (car value)) |
((and (consp value) |
148 |
(markerp (cdr value))) |
(markerp (car value)) |
149 |
(or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) |
(markerp (cdr value))) |
150 |
(signal 'error |
(or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) |
151 |
(list "markers must be in the same buffer" |
(signal 'error |
152 |
(car value) (cdr value)))) |
(list "markers must be in the same buffer" |
153 |
(save-excursion |
(car value) (cdr value)))) |
154 |
(set-buffer (or (marker-buffer (car value)) |
(save-excursion |
155 |
(error "selection is in a killed buffer"))) |
(set-buffer (or (marker-buffer (car value)) |
156 |
(buffer-substring (car value) (cdr value)))) |
(error "selection is in a killed buffer"))) |
157 |
(t nil))) |
(setq str (buffer-substring (car value) (cdr value)))))) |
158 |
|
|
159 |
|
(when str |
160 |
|
;; If TYPE is nil, this is a local request, thus return STR as |
161 |
|
;; is. Otherwise, encode STR. |
162 |
|
(if (not type) |
163 |
|
str |
164 |
|
(setq coding (or next-selection-coding-system selection-coding-system)) |
165 |
|
(if coding |
166 |
|
(setq coding (coding-system-base coding)) |
167 |
|
(setq coding 'raw-text)) |
168 |
|
;; Suppress producing escape sequences for compositions. |
169 |
|
(remove-text-properties 0 (length str) '(composition nil) str) |
170 |
|
(cond |
171 |
|
((eq type 'TEXT) |
172 |
|
(if (not (multibyte-string-p str)) |
173 |
|
;; Don't have to encode unibyte string. |
174 |
|
(setq type 'STRING) |
175 |
|
;; If STR contains only ASCII, Latin-1, and raw bytes, |
176 |
|
;; encode STR by iso-latin-1, and return it as type |
177 |
|
;; `STRING'. Otherwise, encode STR by CODING. In that |
178 |
|
;; case, the returing type depends on CODING. |
179 |
|
(let ((charsets (find-charset-string str))) |
180 |
|
(setq charsets |
181 |
|
(delq 'ascii |
182 |
|
(delq 'latin-iso8859-1 |
183 |
|
(delq 'eight-bit-control |
184 |
|
(delq 'eight-bit-graphic charsets))))) |
185 |
|
(if charsets |
186 |
|
(setq str (encode-coding-string str coding) |
187 |
|
type (if (memq coding '(compound-text |
188 |
|
compound-text-with-extensions)) |
189 |
|
'COMPOUND_TEXT |
190 |
|
'STRING)) |
191 |
|
(setq type 'STRING |
192 |
|
str (encode-coding-string str 'iso-latin-1)))))) |
193 |
|
|
194 |
|
((eq type 'COMPOUND_TEXT) |
195 |
|
(setq str (encode-coding-string str coding))) |
196 |
|
|
197 |
|
((eq type 'STRING) |
198 |
|
(if (memq coding '(compound-text |
199 |
|
compound-text-with-extensions)) |
200 |
|
(setq str (string-make-unibyte str)) |
201 |
|
(setq str (encode-coding-string str coding)))) |
202 |
|
|
203 |
|
((eq type 'UTF8_STRING) |
204 |
|
(setq str (encode-coding-string str 'utf-8))) |
205 |
|
|
206 |
|
(t |
207 |
|
(error "Unknow selection type: %S" type)) |
208 |
|
)) |
209 |
|
|
210 |
|
(setq next-selection-coding-system nil) |
211 |
|
(cons type str)))) |
212 |
|
|
213 |
|
|
214 |
(defun xselect-convert-to-length (selection type value) |
(defun xselect-convert-to-length (selection type value) |
215 |
(let ((value |
(let ((value |
358 |
'((TEXT . xselect-convert-to-string) |
'((TEXT . xselect-convert-to-string) |
359 |
(COMPOUND_TEXT . xselect-convert-to-string) |
(COMPOUND_TEXT . xselect-convert-to-string) |
360 |
(STRING . xselect-convert-to-string) |
(STRING . xselect-convert-to-string) |
361 |
|
(UTF8_STRING . xselect-convert-to-string) |
362 |
(TARGETS . xselect-convert-to-targets) |
(TARGETS . xselect-convert-to-targets) |
363 |
(LENGTH . xselect-convert-to-length) |
(LENGTH . xselect-convert-to-length) |
364 |
(DELETE . xselect-convert-to-delete) |
(DELETE . xselect-convert-to-delete) |