X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3109d63f84fda59852d4caebbd229939b2b7cd94..836c8f066c86d0511a25f4bf926d5cfed1e3a3ef:/lisp/select.el diff --git a/lisp/select.el b/lisp/select.el index bfcf20aa65..1d8d13208f 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -1,8 +1,10 @@ -;;; select.el --- lisp portion of standard selection support. +;;; select.el --- lisp portion of standard selection support +;; Maintainer: FSF ;; Keywords: internal -;; Copyright (c) 1993 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Based partially on earlier release by Lucid. ;; This file is part of GNU Emacs. @@ -18,18 +20,41 @@ ;; GNU General Public License for more details. ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: ;;; Code: ;; This is for temporary compatibility with pre-release Emacs 19. -(fset 'x-selection 'x-get-selection) +(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, -and the argument DATA-TYPE (default `STRING') says how to convert the data." - (x-get-selection-internal (or type 'PRIMARY) (or data-type 'STRING))) +The argument TYPE (default `PRIMARY') says which selection, +and the argument DATA-TYPE (default `STRING') says +how to convert the data. + +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." + (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." @@ -37,18 +62,28 @@ and the argument DATA-TYPE (default `STRING') says how to convert the data." (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), -or a cons of two markers pointing to the same buffer. -In the last case, the selection is considered to be the text -between the markers. -The data may also be a vector of valid non-vector selection values." +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 +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. + +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 (read-string "Store text for pasting: ")) - (list (cons ;; these need not be ordered. - (copy-marker (point-marker)) - (copy-marker (mark-marker)))))) + (list 'PRIMARY (read-string "Set text for pasting: ")) + (list 'PRIMARY (buffer-substring (region-beginning) (region-end))))) ;; This is for temporary compatibility with pre-release Emacs 19. (if (stringp type) (setq type (intern type))) @@ -77,8 +112,7 @@ The data may also be a vector of valid non-vector selection values." (or (integerp (cdr data)) (and (consp (cdr data)) (integerp (car (cdr data)))))) -;;; (and (fboundp 'extentp) -;;; (extentp data)) + (overlayp data) (and (consp data) (markerp (car data)) (markerp (cdr data)) @@ -92,8 +126,8 @@ The data may also be a vector of valid non-vector selection values." ;;; Cut Buffer support (defun x-get-cut-buffer (&optional which-one) - "Returns the value of one of the 8 X server cut-buffers. Optional arg -WHICH-ONE should be a number from 0 to 7, defaulting to 0. + "Returns the value of one of the 8 X server cut-buffers. +Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0. Cut buffers are considered obsolete; you should use selections instead." (x-get-cut-buffer-internal (if which-one @@ -102,14 +136,15 @@ Cut buffers are considered obsolete; you should use selections instead." which-one) 'CUT_BUFFER0))) -(defun x-set-cut-buffer (string) +(defun x-set-cut-buffer (string &optional push) "Store STRING into the X server's primary cut buffer. -The previous value of the primary cut buffer is rotated to the secondary +If PUSH is non-nil, also rotate the cut buffers: +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) - (x-rotate-cut-buffers-internal 1) + (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)) @@ -118,32 +153,92 @@ Cut buffers are considered obsolete; you should use selections instead." ;;; for TIMESTAMP, which is a special case. (defun xselect-convert-to-string (selection type value) - (cond ((stringp value) - value) -;;; ((extentp value) -;;; (save-excursion -;;; (set-buffer (extent-buffer value)) -;;; (buffer-substring (extent-start-position value) -;;; (extent-end-position value)))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) - (signal 'error - (list "markers must be in the same buffer" - (car value) (cdr value)))) - (save-excursion - (set-buffer (or (marker-buffer (car value)) - (error "selection is in a killed buffer"))) - (buffer-substring (car value) (cdr value)))) - (t nil))) + (let (str coding) + ;; Get the actual string from VALUE. + (cond ((stringp value) + (setq str value)) + + ((overlayp value) + (save-excursion + (or (buffer-name (overlay-buffer value)) + (error "selection is in a killed buffer")) + (set-buffer (overlay-buffer value)) + (setq str (buffer-substring (overlay-start value) + (overlay-end value))))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) + (signal 'error + (list "markers must be in the same buffer" + (car value) (cdr value)))) + (save-excursion + (set-buffer (or (marker-buffer (car value)) + (error "selection is in a killed buffer"))) + (setq str (buffer-substring (car value) (cdr 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)) + (if coding + (setq coding (coding-system-base coding)) + (setq coding 'raw-text)) + (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) + (setq str (encode-coding-string str 'utf-8))) + + (t + (error "Unknow selection type: %S" type)) + ))) + + (setq next-selection-coding-system nil) + (cons type str)))) + (defun xselect-convert-to-length (selection type value) (let ((value (cond ((stringp value) (length value)) -;;; ((extentp value) -;;; (extent-length value)) + ((overlayp value) + (abs (- (overlay-end value) (overlay-start value)))) ((and (consp value) (markerp (car value)) (markerp (cdr value))) @@ -178,10 +273,9 @@ Cut buffers are considered obsolete; you should use selections instead." 'NULL) (defun xselect-convert-to-filename (selection type value) - (cond -;;; ((extentp value) -;;; (buffer-file-name (or (extent-buffer value) -;;; (error "selection is in a killed buffer")))) + (cond ((overlayp value) + (buffer-file-name (or (overlay-buffer value) + (error "selection is in a killed buffer")))) ((and (consp value) (markerp (car value)) (markerp (cdr value))) @@ -191,10 +285,9 @@ Cut buffers are considered obsolete; you should use selections instead." (defun xselect-convert-to-charpos (selection type value) (let (a b tmp) - (cond ((cond -;;; ((extentp value) -;;; (setq a (extent-start-position value) -;;; b (extent-end-position value))) + (cond ((cond ((overlayp value) + (setq a (overlay-start value) + b (overlay-end value))) ((and (consp value) (markerp (car value)) (markerp (cdr value))) @@ -214,10 +307,10 @@ Cut buffers are considered obsolete; you should use selections instead." (setq a (marker-position (car value)) b (marker-position (cdr value)) buf (marker-buffer (car value)))) -;;; ((extentp value) -;;; (setq buf (extent-buffer value) -;;; a (extent-start-position value) -;;; b (extent-end-position value))) + ((overlayp value) + (setq buf (overlay-buffer value) + a (overlay-start value) + b (overlay-end value))) ) (save-excursion (set-buffer buf) @@ -236,10 +329,10 @@ Cut buffers are considered obsolete; you should use selections instead." (setq a (car value) b (cdr value) buf (marker-buffer a))) -;;; ((extentp value) -;;; (setq buf (extent-buffer value) -;;; a (extent-start-position value) -;;; b (extent-end-position value))) + ((overlayp value) + (setq buf (overlay-buffer value) + a (overlay-start value) + b (overlay-end value))) ) (save-excursion (set-buffer buf) @@ -262,11 +355,15 @@ Cut buffers are considered obsolete; you should use selections instead." (user-full-name)) (defun xselect-convert-to-class (selection type size) - x-emacs-application-class) + "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) + "Convert selection to name. +This function returns the string \"emacs\"." "emacs") (defun xselect-convert-to-integer (selection type value) @@ -281,7 +378,9 @@ Cut buffers are considered obsolete; you should use selections instead." (setq selection-converter-alist '((TEXT . xselect-convert-to-string) + (COMPOUND_TEXT . xselect-convert-to-string) (STRING . xselect-convert-to-string) + (UTF8_STRING . xselect-convert-to-string) (TARGETS . xselect-convert-to-targets) (LENGTH . xselect-convert-to-length) (DELETE . xselect-convert-to-delete) @@ -301,4 +400,5 @@ Cut buffers are considered obsolete; you should use selections instead." (provide 'select) -;;; select.el ends here. +;;; arch-tag: bb634f97-8a3b-4b0a-b940-f6e09982328c +;;; select.el ends here