X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/eb1416b9bcf82289fd2ad9389bafe135da9483db..4e35ba2f2e682faafc2a0f4abd738d3d208cbc8a:/lisp/select.el diff --git a/lisp/select.el b/lisp/select.el index 6f9fa1fd04..9b711ee1d7 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -3,7 +3,8 @@ ;; Maintainer: FSF ;; Keywords: internal -;; Copyright (c) 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Based partially on earlier release by Lucid. ;; This file is part of GNU Emacs. @@ -20,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -31,14 +32,29 @@ (defalias 'x-selection 'x-get-selection) (defun x-get-selection (&optional type data-type) "Return the value of an X Windows selection. -The argument TYPE (default `PRIMARY') says which selection, +The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING') says how to convert the data. -TYPE may be `SECONDARY' or `CLIPBOARD', in addition to `PRIMARY'. +TYPE may be any symbol \(but nil stands for `PRIMARY'). However, +only a few symbols are commonly used. They conventionally have +all upper-case names. The most often used ones, in addition to +`PRIMARY', are `SECONDARY' and `CLIPBOARD'. + DATA-TYPE is usually `STRING', but can also be one of the symbols in `selection-converter-alist', which see." - (x-get-selection-internal (or type 'PRIMARY) (or data-type 'STRING))) + (let ((data (x-get-selection-internal (or type 'PRIMARY) + (or data-type 'STRING))) + coding) + (when (and (stringp data) + (setq data-type (get-text-property 0 'foreign-selection data))) + (setq coding (if (eq data-type 'UTF8_STRING) + 'utf-8 + (or next-selection-coding-system + selection-coding-system)) + data (decode-coding-string data coding)) + (put-text-property 0 (length data) 'foreign-selection data-type data)) + data)) (defun x-get-clipboard () "Return text pasted to the clipboard." @@ -46,20 +62,25 @@ in `selection-converter-alist', which see." (defun x-set-selection (type data) "Make an X Windows selection of type TYPE and value DATA. -The argument TYPE (default `PRIMARY') says which selection, -and DATA specifies the contents. DATA may be a string, -a symbol, an integer (or a cons of two integers or list of two integers). +The argument TYPE (nil means `PRIMARY') says which selection, and +DATA specifies the contents. TYPE must be a symbol. \(It can also +be a string, which stands for the symbol with that name, but this +is considered obsolete.) DATA may be a string, a symbol, an +integer (or a cons of two integers or list of two integers). The selection may also be a cons of two markers pointing to the same buffer, -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 between the markers *at whatever time the selection is examined*. Thus, editing done in the buffer after you specify the selection can alter the effective value of the selection. The data may also be a vector of valid non-vector selection values. -Interactively, the text of the region is used as the selection value -if the prefix arg is set." +The return value is DATA. + +Interactively, this command sets the primary selection. Without +prefix argument, it reads the selection in the minibuffer. With +prefix argument, it uses the text of the region as the selection value ." (interactive (if (not current-prefix-arg) (list 'PRIMARY (read-string "Set text for pasting: ")) (list 'PRIMARY (buffer-substring (region-beginning) (region-end))))) @@ -118,11 +139,10 @@ Cut buffers are considered obsolete; you should use selections instead." (defun x-set-cut-buffer (string &optional push) "Store STRING into the X server's primary cut buffer. If PUSH is non-nil, also rotate the cut buffers: -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 cut buffer, and the second to the third, and so on (there are 8 buffers.) Cut buffers are considered obsolete; you should use selections instead." - ;; Check the data type of STRING. - (substring string 0 0) + (or (stringp string) (signal 'wrong-type-argument (list 'string string))) (if push (x-rotate-cut-buffers-internal 1)) (x-store-cut-buffer-internal 'CUT_BUFFER0 string)) @@ -132,6 +152,41 @@ Cut buffers are considered obsolete; you should use selections instead." ;;; Every selection type that Emacs handles is implemented this way, except ;;; for TIMESTAMP, which is a special case. +(eval-when-compile (require 'ccl)) + +(define-ccl-program ccl-check-utf-8 + '(0 + ((r0 = 1) + (loop + (read-if (r1 < #x80) (repeat) + ((r0 = 0) + (if (r1 < #xC2) (end)) + (read r2) + (if ((r2 & #xC0) != #x80) (end)) + (if (r1 < #xE0) ((r0 = 1) (repeat))) + (read r2) + (if ((r2 & #xC0) != #x80) (end)) + (if (r1 < #xF0) ((r0 = 1) (repeat))) + (read r2) + (if ((r2 & #xC0) != #x80) (end)) + (if (r1 < #xF8) ((r0 = 1) (repeat))) + (read r2) + (if ((r2 & #xC0) != #x80) (end)) + (if (r1 == #xF8) ((r0 = 1) (repeat))) + (end)))))) + "Check if the input unibyte string is a valid UTF-8 sequence or not. +If it is valid, set the register `r0' to 1, else set it to 0.") + +(defun string-utf-8-p (string) + "Return non-nil iff STRING is a unibyte string of valid UTF-8 sequence." + (if (or (not (stringp string)) + (multibyte-string-p string)) + (error "Not a unibyte string: %s" string)) + (let ((status (make-vector 9 0))) + (ccl-execute-on-string ccl-check-utf-8 status string) + (= (aref status 0) 1))) + + (defun xselect-convert-to-string (selection type value) (let (str coding) ;; Get the actual string from VALUE. @@ -166,47 +221,50 @@ Cut buffers are considered obsolete; you should use selections instead." (if coding (setq coding (coding-system-base coding)) (setq coding 'raw-text)) - ;; Suppress producing escape sequences for compositions. - (remove-text-properties 0 (length str) '(composition nil) str) - (cond - ((eq type 'TEXT) - (if (not (multibyte-string-p str)) - ;; Don't have to encode unibyte string. - (setq type 'STRING) - ;; If STR contains only ASCII, Latin-1, and raw bytes, - ;; encode STR by iso-latin-1, and return it as type - ;; `STRING'. Otherwise, encode STR by CODING. In that - ;; case, the returing type depends on CODING. - (let ((charsets (find-charset-string str))) - (setq charsets - (delq 'ascii - (delq 'latin-iso8859-1 - (delq 'eight-bit-control - (delq 'eight-bit-graphic charsets))))) - (if charsets - (setq str (encode-coding-string str coding) - type (if (memq coding '(compound-text - compound-text-with-extensions)) - 'COMPOUND_TEXT - 'STRING)) - (setq type 'STRING - str (encode-coding-string str 'iso-latin-1)))))) - - ((eq type 'COMPOUND_TEXT) - (setq str (encode-coding-string str coding))) - - ((eq type 'STRING) - (if (memq coding '(compound-text - compound-text-with-extensions)) - (setq str (string-make-unibyte str)) - (setq str (encode-coding-string str coding)))) - - ((eq type 'UTF8_STRING) - (setq str (encode-coding-string str 'utf-8))) - - (t - (error "Unknow selection type: %S" type)) - )) + (let ((inhibit-read-only t)) + ;; Suppress producing escape sequences for compositions. + (remove-text-properties 0 (length str) '(composition nil) str) + (cond + ((eq type 'TEXT) + (if (not (multibyte-string-p str)) + ;; Don't have to encode unibyte string. + (setq type 'STRING) + ;; If STR contains only ASCII, Latin-1, and raw bytes, + ;; encode STR by iso-latin-1, and return it as type + ;; `STRING'. Otherwise, encode STR by CODING. In that + ;; case, the returing type depends on CODING. + (let ((charsets (find-charset-string str))) + (setq charsets + (delq 'ascii + (delq 'latin-iso8859-1 + (delq 'eight-bit-control + (delq 'eight-bit-graphic charsets))))) + (if charsets + (setq str (encode-coding-string str coding) + type (if (memq coding '(compound-text + compound-text-with-extensions)) + 'COMPOUND_TEXT + 'STRING)) + (setq type 'STRING + str (encode-coding-string str 'iso-latin-1)))))) + + ((eq type 'COMPOUND_TEXT) + (setq str (encode-coding-string str coding))) + + ((eq type 'STRING) + (if (memq coding '(compound-text + compound-text-with-extensions)) + (setq str (string-make-unibyte str)) + (setq str (encode-coding-string str coding)))) + + ((eq type 'UTF8_STRING) + (if (multibyte-string-p str) + (setq str (encode-coding-string str 'utf-8))) + (if (not (string-utf-8-p str)) + (setq str nil))) ;; Decline request as we don't have UTF-8 data. + (t + (error "Unknow selection type: %S" type)) + ))) (setq next-selection-coding-system nil) (cons type str)))) @@ -379,4 +437,5 @@ This function returns the string \"emacs\"." (provide 'select) +;;; arch-tag: bb634f97-8a3b-4b0a-b940-f6e09982328c ;;; select.el ends here