X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6cda144ffe7e8da08b15430072f3b112967d5281..23a8a5ab697f3389ea6478cdfefe4e67fff28051:/lisp/select.el diff --git a/lisp/select.el b/lisp/select.el index e4c3addc69..10c8f0b1ef 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -1,12 +1,10 @@ ;;; select.el --- lisp portion of standard selection support +;; Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc. + ;; Maintainer: FSF ;; Keywords: internal -;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. -;; Based partially on earlier release by Lucid. - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -24,11 +22,20 @@ ;;; Commentary: +;; Based partially on earlier release by Lucid. + ;;; Code: (defcustom selection-coding-system nil - "Coding system for communicating with other X clients. + "Coding system for communicating with other programs. + +For MS-Windows and MS-DOS: +When sending or receiving text via selection and clipboard, the text +is encoded or decoded by this coding system. The default value is +the current system default encoding on 9x/Me, `utf-16le-dos' +\(Unicode) on NT/W2K/XP, and `iso-latin-1-dos' on MS-DOS. +For X Windows: When sending text via selection and clipboard, if the target data-type matches with the type of this coding system, it is used for encoding the text. Otherwise (including the case that this @@ -58,17 +65,18 @@ The default value is nil." (set symbol value))) (defvar next-selection-coding-system nil - "Coding system for the next communication with other X clients. + "Coding system for the next communication with other programs. Usually, `selection-coding-system' is used for communicating with -other X clients. But, if this variable is set, it is used for -the next communication only. After the communication, this -variable is set to nil.") +other programs (X Windows clients or MS Windows programs). But, if this +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)) -;; This is for temporary compatibility with pre-release Emacs 19. -(defalias 'x-selection 'x-get-selection) +;; Only declared obsolete in 23.3. +(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") + (defun x-get-selection (&optional type data-type) "Return the value of an X Windows selection. The argument TYPE (default `PRIMARY') says which selection, @@ -115,7 +123,7 @@ in `selection-converter-alist', which see." (selection &optional time)) (defun x-set-selection (type data) - "Make an X Windows selection of type TYPE and value DATA. + "Make an X selection of type TYPE and value DATA. 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 @@ -134,13 +142,14 @@ 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 ." +prefix argument, it uses the text of the region as the selection value. + +Note that on MS-Windows, primary and secondary selections set by Emacs +are not available to other programs." (interactive (if (not current-prefix-arg) (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))) + (if (stringp type) (setq type (intern type))) (or (x-valid-simple-selection-p data) (and (vectorp data) (let ((valid t) @@ -158,84 +167,61 @@ prefix argument, it uses the text of the region as the selection value ." data) (defun x-valid-simple-selection-p (data) - (or (stringp data) - (symbolp data) - (integerp data) - (and (consp data) - (integerp (car data)) - (or (integerp (cdr data)) - (and (consp (cdr data)) - (integerp (car (cdr data)))))) - (overlayp data) + (or (bufferp data) (and (consp data) (markerp (car data)) (markerp (cdr data)) (marker-buffer (car data)) - (marker-buffer (cdr data)) - (eq (marker-buffer (car data)) - (marker-buffer (cdr data))) (buffer-name (marker-buffer (car data))) - (buffer-name (marker-buffer (cdr data)))))) - -;;; Cut Buffer support - -(declare-function x-get-cut-buffer-internal "xselect.c") - -(defun x-get-cut-buffer (&optional which-one) - "Return 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 - (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3 - CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7] - which-one) - 'CUT_BUFFER0))) - -(declare-function x-rotate-cut-buffers-internal "xselect.c") -(declare-function x-store-cut-buffer-internal "xselect.c") - -(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 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." - (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)) - + (eq (marker-buffer (car data)) + (marker-buffer (cdr data)))) + (stringp data) + (and (overlayp data) + (overlay-buffer data) + (buffer-name (overlay-buffer data))) + (symbolp data) + (integerp data))) ;; Functions to convert the selection into various other selection types. ;; Every selection type that Emacs handles is implemented this way, except ;; for TIMESTAMP, which is a special case. -(defun xselect-convert-to-string (selection type value) +(defun xselect--selection-bounds (value) + "Return bounds of X selection value VALUE. +The return value is a list (BEG END BUF) if VALUE is a cons of +two markers or an overlay. Otherwise, it is nil." + (cond ((bufferp value) + (with-current-buffer value + (when (mark t) + (list (mark t) (point) value)))) + ((and (consp value) + (markerp (car value)) + (markerp (cdr value))) + (when (and (marker-buffer (car value)) + (buffer-name (marker-buffer (car value))) + (eq (marker-buffer (car value)) + (marker-buffer (cdr value)))) + (list (marker-position (car value)) + (marker-position (cdr value)) + (marker-buffer (car value))))) + ((overlayp value) + (when (overlay-buffer value) + (list (overlay-start value) + (overlay-end value) + (overlay-buffer value)))))) + +(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)) - - ((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)))))) - + ((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. @@ -288,35 +274,24 @@ Cut buffers are considered obsolete; you should use selections instead." (setq str (string-make-unibyte str))) (t - (error "Unknow selection type: %S" type)) - ))) + (error "Unknown selection type: %S" type))))) (setq next-selection-coding-system nil) (cons type str)))) +(defun xselect-convert-to-length (_selection _type value) + (let ((len (cond ((stringp value) + (length value)) + ((setq value (xselect--selection-bounds value)) + (abs (- (nth 0 value) (nth 1 value))))))) + (if len + (xselect--int-to-cons len)))) -(defun xselect-convert-to-length (selection type value) - (let ((value - (cond ((stringp value) - (length value)) - ((overlayp value) - (abs (- (overlay-end value) (overlay-start 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)))) - (abs (- (car value) (cdr value))))))) - (if value ; force it to be in 32-bit format. - (cons (ash value -16) (logand value 65535)) - nil))) - -(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)) @@ -327,117 +302,77 @@ Cut buffers are considered obsolete; you should use selections instead." (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) - (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))) - (buffer-file-name (or (marker-buffer (car value)) - (error "selection is in a killed buffer")))) - (t nil))) - -(defun xselect-convert-to-charpos (selection type value) - (let (a b tmp) - (cond ((cond ((overlayp value) - (setq a (overlay-start value) - b (overlay-end value))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (car value) - b (cdr value)))) - (setq a (1- a) b (1- b)) ; zero-based - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-lineno (selection type value) - (let (a b buf tmp) - (cond ((cond ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (marker-position (car value)) - b (marker-position (cdr value)) - buf (marker-buffer (car value)))) - ((overlayp value) - (setq buf (overlay-buffer value) - a (overlay-start value) - b (overlay-end value))) - ) - (save-excursion - (set-buffer buf) - (setq a (count-lines 1 a) - b (count-lines 1 b))) - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-colno (selection type value) - (let (a b buf tmp) - (cond ((cond ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (car value) - b (cdr value) - buf (marker-buffer a))) - ((overlayp value) - (setq buf (overlay-buffer value) - a (overlay-start value) - b (overlay-end value))) - ) - (save-excursion - (set-buffer buf) - (goto-char a) - (setq a (current-column)) - (goto-char b) - (setq b (current-column))) - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-os (selection type size) +(defun xselect-convert-to-filename (_selection _type value) + (when (setq value (xselect--selection-bounds value)) + (buffer-file-name (nth 2 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) + (when (setq value (xselect--selection-bounds value)) + (with-current-buffer (nth 2 value) + (let ((beg (line-number-at-pos (nth 0 value))) + (end (line-number-at-pos (nth 1 value)))) + (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) + (when (setq value (xselect--selection-bounds value)) + (with-current-buffer (nth 2 value) + (let ((beg (progn (goto-char (nth 0 value)) (current-column))) + (end (progn (goto-char (nth 1 value)) (current-column)))) + (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-host (selection type size) +(defun xselect-convert-to-host (_selection _type _size) (system-name)) -(defun xselect-convert-to-user (selection type size) +(defun xselect-convert-to-user (_selection _type _size) (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) - (cons (ash value -16) (logand value 65535)))) + (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) @@ -457,10 +392,9 @@ This function returns the string \"emacs\"." (NAME . xselect-convert-to-name) (ATOM . xselect-convert-to-atom) (INTEGER . xselect-convert-to-integer) - (_EMACS_INTERNAL . xselect-convert-to-identity) - )) + (SAVE_TARGETS . xselect-convert-to-save-targets) + (_EMACS_INTERNAL . xselect-convert-to-identity))) (provide 'select) -;; arch-tag: bb634f97-8a3b-4b0a-b940-f6e09982328c ;;; select.el ends here