X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/77ab81d0545e980c57c0a35510ade29a9e43b4cd..26ea164c7e18b893a661eea9436338cbbab557e1:/lisp/select.el diff --git a/lisp/select.el b/lisp/select.el index b8bc8ff25e..c4d020343a 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -1,9 +1,8 @@ ;;; select.el --- lisp portion of standard selection support -;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2001-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; This file is part of GNU Emacs. @@ -73,7 +72,7 @@ variable is set, it is used for the next communication only. After the communication, this variable is set to nil.") (declare-function x-get-selection-internal "xselect.c" - (selection-symbol target-type &optional time-stamp)) + (selection-symbol target-type &optional time-stamp terminal)) ;; Only declared obsolete in 23.3. (define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") @@ -90,7 +89,8 @@ 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." +in `selection-converter-alist', which see. This argument is +ignored on MS-Windows and MS-DOS." (let ((data (x-get-selection-internal (or type 'PRIMARY) (or data-type 'STRING))) coding) @@ -107,7 +107,7 @@ in `selection-converter-alist', which see." ((eq data-type 'STRING) 'iso-8859-1) (t - (error "Unknow selection data type: %S" type)))) + (error "Unknown selection data type: %S" type)))) data (if coding (decode-coding-string data coding) (string-to-multibyte data))) (setq next-selection-coding-system nil) @@ -119,9 +119,9 @@ in `selection-converter-alist', which see." (x-get-selection-internal 'CLIPBOARD 'STRING)) (declare-function x-own-selection-internal "xselect.c" - (selection-name selection-value)) + (selection-name selection-value &optional frame)) (declare-function x-disown-selection-internal "xselect.c" - (selection &optional time)) + (selection &optional time terminal)) (defun x-set-selection (type data) "Make an X selection of type TYPE and value DATA. @@ -214,44 +214,55 @@ two markers or an overlay. Otherwise, it is nil." (defun xselect--int-to-cons (n) (cons (ash n -16) (logand n 65535))) -(defun xselect-convert-to-string (selection type value) - (let (str coding) - ;; Get the actual string from VALUE. - (cond ((stringp value) - (setq str value)) - ((setq value (xselect--selection-bounds value)) - (with-current-buffer (nth 2 value) - (setq str (buffer-substring (nth 0 value) - (nth 1 value)))))) - (when str - ;; If TYPE is nil, this is a local request, thus return STR as - ;; is. Otherwise, encode STR. - (if (not type) - str - (setq coding (or next-selection-coding-system selection-coding-system)) +(defun xselect--encode-string (type str &optional can-modify) + (when str + ;; If TYPE is nil, this is a local request; return STR as-is. + (if (null type) + str + ;; Otherwise, encode STR. + (let ((coding (or next-selection-coding-system + selection-coding-system))) (if coding (setq coding (coding-system-base coding))) (let ((inhibit-read-only t)) ;; Suppress producing escape sequences for compositions. + ;; But avoid modifying the string if it's a buffer name etc. + (unless can-modify (setq str (substring str 0))) (remove-text-properties 0 (length str) '(composition nil) str) - (if (eq type 'TEXT) - ;; TEXT is a polymorphic target. We must select the - ;; actual type from `UTF8_STRING', `COMPOUND_TEXT', - ;; `STRING', and `C_STRING'. - (if (not (multibyte-string-p str)) - (setq type 'C_STRING) - (let (non-latin-1 non-unicode eight-bit) - (mapc #'(lambda (x) - (if (>= x #x100) - (if (< x #x110000) - (setq non-latin-1 t) - (if (< x #x3FFF80) - (setq non-unicode t) - (setq eight-bit t))))) - str) - (setq type (if non-unicode 'COMPOUND_TEXT - (if non-latin-1 'UTF8_STRING - (if eight-bit 'C_STRING 'STRING))))))) + ;; For X selections, TEXT is a polymorphic target; choose + ;; the actual type from `UTF8_STRING', `COMPOUND_TEXT', + ;; `STRING', and `C_STRING'. On Nextstep, always use UTF-8 + ;; (see ns_string_to_pasteboard_internal in nsselect.m). + (when (eq type 'TEXT) + (cond + ((featurep 'ns) + (setq type 'UTF8_STRING)) + ((not (multibyte-string-p str)) + (setq type 'C_STRING)) + (t + (let (non-latin-1 non-unicode eight-bit) + (mapc #'(lambda (x) + (if (>= x #x100) + (if (< x #x110000) + (setq non-latin-1 t) + (if (< x #x3FFF80) + (setq non-unicode t) + (setq eight-bit t))))) + str) + (setq type (if (or non-unicode + (and + non-latin-1 + ;; If a coding is specified for + ;; selection, and that is + ;; compatible with COMPOUND_TEXT, + ;; use it. + coding + (eq (coding-system-get coding :mime-charset) + 'x-ctext))) + 'COMPOUND_TEXT + (if non-latin-1 'UTF8_STRING + (if eight-bit 'C_STRING + 'STRING)))))))) (cond ((eq type 'UTF8_STRING) (if (or (not coding) @@ -280,7 +291,15 @@ two markers or an overlay. Otherwise, it is nil." (setq next-selection-coding-system nil) (cons type str)))) -(defun xselect-convert-to-length (selection type value) +(defun xselect-convert-to-string (_selection type value) + (let ((str (cond ((stringp value) value) + ((setq value (xselect--selection-bounds value)) + (with-current-buffer (nth 2 value) + (buffer-substring (nth 0 value) + (nth 1 value))))))) + (xselect--encode-string type str t))) + +(defun xselect-convert-to-length (_selection _type value) (let ((len (cond ((stringp value) (length value)) ((setq value (xselect--selection-bounds value)) @@ -288,9 +307,11 @@ two markers or an overlay. Otherwise, it is nil." (if len (xselect--int-to-cons len)))) -(defun xselect-convert-to-targets (selection type value) +(defun xselect-convert-to-targets (_selection _type _value) ;; return a vector of atoms, but remove duplicates first. - (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist))) + (let* ((all (cons 'TIMESTAMP + (cons 'MULTIPLE + (mapcar 'car selection-converter-alist)))) (rest all)) (while rest (cond ((memq (car rest) (cdr rest)) @@ -301,25 +322,25 @@ two markers or an overlay. Otherwise, it is nil." (setq rest (cdr rest))))) (apply 'vector all))) -(defun xselect-convert-to-delete (selection type value) +(defun xselect-convert-to-delete (selection _type _value) (x-disown-selection-internal selection) ;; A return value of nil means that we do not know how to do this conversion, ;; and replies with an "error". A return value of NULL means that we have ;; done the conversion (and any side-effects) but have no value to return. 'NULL) -(defun xselect-convert-to-filename (selection type value) +(defun xselect-convert-to-filename (_selection _type value) (when (setq value (xselect--selection-bounds value)) - (buffer-file-name (nth 2 value)))) + (xselect--encode-string 'TEXT (buffer-file-name (nth 2 value))))) -(defun xselect-convert-to-charpos (selection type value) +(defun xselect-convert-to-charpos (_selection _type value) (when (setq value (xselect--selection-bounds value)) (let ((beg (1- (nth 0 value))) ; zero-based (end (1- (nth 1 value)))) (cons 'SPAN (vector (xselect--int-to-cons (min beg end)) (xselect--int-to-cons (max beg end))))))) -(defun xselect-convert-to-lineno (selection type value) +(defun xselect-convert-to-lineno (_selection _type value) (when (setq value (xselect--selection-bounds value)) (with-current-buffer (nth 2 value) (let ((beg (line-number-at-pos (nth 0 value))) @@ -327,7 +348,7 @@ two markers or an overlay. Otherwise, it is nil." (cons 'SPAN (vector (xselect--int-to-cons (min beg end)) (xselect--int-to-cons (max beg end)))))))) -(defun xselect-convert-to-colno (selection type value) +(defun xselect-convert-to-colno (_selection _type value) (when (setq value (xselect--selection-bounds value)) (with-current-buffer (nth 2 value) (let ((beg (progn (goto-char (nth 0 value)) (current-column))) @@ -335,37 +356,43 @@ two markers or an overlay. Otherwise, it is nil." (cons 'SPAN (vector (xselect--int-to-cons (min beg end)) (xselect--int-to-cons (max beg end)))))))) -(defun xselect-convert-to-os (selection type size) - (symbol-name system-type)) +(defun xselect-convert-to-os (_selection _type _size) + (xselect--encode-string 'TEXT (symbol-name system-type))) -(defun xselect-convert-to-host (selection type size) - (system-name)) +(defun xselect-convert-to-host (_selection _type _size) + (xselect--encode-string 'TEXT (system-name))) -(defun xselect-convert-to-user (selection type size) - (user-full-name)) +(defun xselect-convert-to-user (_selection _type _size) + (xselect--encode-string 'TEXT (user-full-name))) -(defun xselect-convert-to-class (selection type size) +(defun xselect-convert-to-class (_selection _type _size) "Convert selection to class. This function returns the string \"Emacs\"." "Emacs") ;; We do not try to determine the name Emacs was invoked with, ;; because it is not clean for a program's behavior to depend on that. -(defun xselect-convert-to-name (selection type size) +(defun xselect-convert-to-name (_selection _type _size) "Convert selection to name. This function returns the string \"emacs\"." "emacs") -(defun xselect-convert-to-integer (selection type value) +(defun xselect-convert-to-integer (_selection _type value) (and (integerp value) (xselect--int-to-cons value))) -(defun xselect-convert-to-atom (selection type value) +(defun xselect-convert-to-atom (_selection _type value) (and (symbolp value) value)) -(defun xselect-convert-to-identity (selection type value) ; used internally +(defun xselect-convert-to-identity (_selection _type value) ; used internally (vector value)) +;; Null target that tells clipboard managers we support SAVE_TARGETS +;; (see freedesktop.org Clipboard Manager spec). +(defun xselect-convert-to-save-targets (selection _type _value) + (when (eq selection 'CLIPBOARD) + 'NULL)) + (setq selection-converter-alist '((TEXT . xselect-convert-to-string) (COMPOUND_TEXT . xselect-convert-to-string) @@ -385,6 +412,7 @@ This function returns the string \"emacs\"." (NAME . xselect-convert-to-name) (ATOM . xselect-convert-to-atom) (INTEGER . xselect-convert-to-integer) + (SAVE_TARGETS . xselect-convert-to-save-targets) (_EMACS_INTERNAL . xselect-convert-to-identity))) (provide 'select)