mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-02-04 20:27:45 +00:00
(x-select-request-type): New variable.
(x-select-utf8-or-ctext): New function. (x-selection-value): New function. (x-cut-buffer-or-selection-value): Call x-selection-value to get a selection data. Set next-selection-coding-system to nil.
This commit is contained in:
parent
f147fd76db
commit
c7d9df18e4
@ -2138,6 +2138,105 @@ This is in addition to, but in preference to, the primary selection."
|
|||||||
(setq x-last-selected-text-clipboard text))
|
(setq x-last-selected-text-clipboard text))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(defvar x-select-request-type nil
|
||||||
|
"*Data type request for X selection.
|
||||||
|
The value is nil, one of the following data types, or a list of them:
|
||||||
|
`COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT'
|
||||||
|
|
||||||
|
If the value is nil, try `COMPOUND_TEXT' and `UTF8_STRING', and
|
||||||
|
use the more appropriate result. If both fail, try `STRING', and
|
||||||
|
then `TEXT'.
|
||||||
|
|
||||||
|
If the value is one of the above symbols, try only the specified
|
||||||
|
type.
|
||||||
|
|
||||||
|
If the value is a list of them, try each of them in the specified
|
||||||
|
order until succeed.")
|
||||||
|
|
||||||
|
;; Helper function for x-selection-value. Select UTF8 or CTEXT
|
||||||
|
;; whichever is more appropriate. Here, we use this heurisitcs.
|
||||||
|
;;
|
||||||
|
;; (1) If their lengthes are different, select the longer one. This
|
||||||
|
;; is because an X client may just cut off unsupported characters.
|
||||||
|
;;
|
||||||
|
;; (2) Otherwise, if the Nth character of CTEXT is an ASCII
|
||||||
|
;; character that is different from the Nth character of UTF8,
|
||||||
|
;; select UTF8. This is because an X client may replace unsupported
|
||||||
|
;; characters with some ASCII character (typically ` ' or `?') in
|
||||||
|
;; CTEXT.
|
||||||
|
;;
|
||||||
|
;; (3) Otherwise, select CTEXT. This is because legacy charsets are
|
||||||
|
;; better for the current Emacs, especially when the selection owner
|
||||||
|
;; is also Emacs.
|
||||||
|
|
||||||
|
(defun x-select-utf8-or-ctext (utf8 ctext)
|
||||||
|
(let ((len-utf8 (length utf8))
|
||||||
|
(len-ctext (length ctext))
|
||||||
|
(selected ctext)
|
||||||
|
(i 0)
|
||||||
|
char)
|
||||||
|
(if (/= len-utf8 len-ctext)
|
||||||
|
(if (> len-utf8 len-ctext) utf8 ctext)
|
||||||
|
(while (< i len-utf8)
|
||||||
|
(setq char (aref ctext i))
|
||||||
|
(if (and (< char 128) (/= char (aref utf8 i)))
|
||||||
|
(setq selected utf8
|
||||||
|
i len-utf8)
|
||||||
|
(setq i (1+ i))))
|
||||||
|
selected)))
|
||||||
|
|
||||||
|
(defun x-selection-value (type)
|
||||||
|
(let (text)
|
||||||
|
(cond ((null x-select-request-type)
|
||||||
|
(let (utf8 ctext utf8-coding)
|
||||||
|
;; We try both UTF8_STRING and COMPOUND_TEXT, and choose
|
||||||
|
;; the more appropriate one. If both fail, try STRING.
|
||||||
|
|
||||||
|
;; At first try UTF8_STRING.
|
||||||
|
(setq utf8 (condition-case nil
|
||||||
|
(x-get-selection type 'UTF8_STRING)
|
||||||
|
(error nil))
|
||||||
|
utf8-coding last-coding-system-used)
|
||||||
|
(if utf8
|
||||||
|
;; If it is a locale selection, choose it.
|
||||||
|
(or (get-text-property 0 'foreign-selection utf8)
|
||||||
|
(setq text utf8)))
|
||||||
|
;; If not yet decided, try COMPOUND_TEXT.
|
||||||
|
(if (not text)
|
||||||
|
(if (setq ctext (condition-case nil
|
||||||
|
(x-get-selection type 'COMPOUND_TEXT)
|
||||||
|
(error nil)))
|
||||||
|
;; If UTF8_STRING was also successful, choose the
|
||||||
|
;; more appropriate one from UTF8 and CTEXT.
|
||||||
|
(if utf8
|
||||||
|
(setq text (x-select-utf8-or-ctext utf8 ctext))
|
||||||
|
;; Othewise, choose CTEXT.
|
||||||
|
(setq text ctext))))
|
||||||
|
;; If not yet decided, try STRING.
|
||||||
|
(or text
|
||||||
|
(setq text (condition-case nil
|
||||||
|
(x-get-selection type 'STRING)
|
||||||
|
(error nil))))
|
||||||
|
(if (eq text utf8)
|
||||||
|
(setq last-coding-system-used utf8-coding))))
|
||||||
|
|
||||||
|
((consp x-select-request-type)
|
||||||
|
(let ((tail x-select-request-type))
|
||||||
|
(while (and tail (not text))
|
||||||
|
(condition-case nil
|
||||||
|
(setq text (x-get-selection type (car tail)))
|
||||||
|
(error nil))
|
||||||
|
(setq tail (cdr tail)))))
|
||||||
|
|
||||||
|
(t
|
||||||
|
(condition-case nil
|
||||||
|
(setq text (x-get-selection type x-select-request-type))
|
||||||
|
(error nil))))
|
||||||
|
|
||||||
|
(if text
|
||||||
|
(remove-text-properties 0 (length text) '(foreign-selection nil) text))
|
||||||
|
text))
|
||||||
|
|
||||||
;;; Return the value of the current X selection.
|
;;; Return the value of the current X selection.
|
||||||
;;; Consult the selection, and the cut buffer. Treat empty strings
|
;;; Consult the selection, and the cut buffer. Treat empty strings
|
||||||
;;; as if they were unset.
|
;;; as if they were unset.
|
||||||
@ -2147,15 +2246,7 @@ This is in addition to, but in preference to, the primary selection."
|
|||||||
(defun x-cut-buffer-or-selection-value ()
|
(defun x-cut-buffer-or-selection-value ()
|
||||||
(let (clip-text primary-text cut-text)
|
(let (clip-text primary-text cut-text)
|
||||||
(when x-select-enable-clipboard
|
(when x-select-enable-clipboard
|
||||||
;; Don't die if x-get-selection signals an error.
|
(setq clip-text (x-selection-value 'CLIPBOARD))
|
||||||
(if (null clip-text)
|
|
||||||
(condition-case c
|
|
||||||
(setq clip-text (x-get-selection 'CLIPBOARD 'COMPOUND_TEXT))
|
|
||||||
(error nil)))
|
|
||||||
(if (null clip-text)
|
|
||||||
(condition-case c
|
|
||||||
(setq clip-text (x-get-selection 'CLIPBOARD 'STRING))
|
|
||||||
(error nil)))
|
|
||||||
(if (string= clip-text "") (setq clip-text nil))
|
(if (string= clip-text "") (setq clip-text nil))
|
||||||
|
|
||||||
;; Check the CLIPBOARD selection for 'newness', is it different
|
;; Check the CLIPBOARD selection for 'newness', is it different
|
||||||
@ -2175,15 +2266,7 @@ This is in addition to, but in preference to, the primary selection."
|
|||||||
(setq x-last-selected-text-clipboard clip-text))))
|
(setq x-last-selected-text-clipboard clip-text))))
|
||||||
)
|
)
|
||||||
|
|
||||||
;; Don't die if x-get-selection signals an error.
|
(setq primary-text (x-selection-value 'PRIMARY))
|
||||||
(if (null primary-text)
|
|
||||||
(condition-case c
|
|
||||||
(setq primary-text (x-get-selection 'PRIMARY 'COMPOUND_TEXT))
|
|
||||||
(error nil)))
|
|
||||||
(if (null primary-text)
|
|
||||||
(condition-case c
|
|
||||||
(setq primary-text (x-get-selection 'PRIMARY 'STRING))
|
|
||||||
(error nil)))
|
|
||||||
;; Check the PRIMARY selection for 'newness', is it different
|
;; Check the PRIMARY selection for 'newness', is it different
|
||||||
;; from what we remebered them to be last time we did a
|
;; from what we remebered them to be last time we did a
|
||||||
;; cut/paste operation.
|
;; cut/paste operation.
|
||||||
@ -2218,6 +2301,9 @@ This is in addition to, but in preference to, the primary selection."
|
|||||||
(t
|
(t
|
||||||
(setq x-last-selected-text-cut cut-text))))
|
(setq x-last-selected-text-cut cut-text))))
|
||||||
|
|
||||||
|
;; As we have done one selection, clear this now.
|
||||||
|
(setq next-selection-coding-system nil)
|
||||||
|
|
||||||
;; At this point we have recorded the current values for the
|
;; At this point we have recorded the current values for the
|
||||||
;; selection from clipboard (if we are supposed to) primary,
|
;; selection from clipboard (if we are supposed to) primary,
|
||||||
;; and cut buffer. So return the first one that has changed
|
;; and cut buffer. So return the first one that has changed
|
||||||
|
Loading…
x
Reference in New Issue
Block a user