\f
* Changes in Emacs 25.1
-** x-select-enable-clipboard is renamed gui-select-enable-clipboard.
-Additionally it now also applies to OSX and GNUstep.
+** x-select-enable-clipboard is renamed select-enable-clipboard.
+x-select-enable-primary and renamed select-enable-primary.
+Additionally they both now apply to all systems (OSX, GNUstep, Windows, you
+name it), with the proviso that on some systems (e.g. Windows)
+select-enable-primary is ineffective since the system doesn't
+have the equivalent of a primary selection.
+++
** terpri gets an optional arg ENSURE to conditionally output a newline.
+2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Get rid of backend-dependent selection-handling functions for kill/yank
+ and make it generic instead by relying on the lower-level selection
+ management functions.
+
+ * select.el (select-enable-clipboard): Rename from
+ gui-select-enable-clipboard.
+ (select-enable-primary): Move from x-win.el and rename from
+ x-select-enable-primary.
+ (gui-last-selected-text): Remove.
+ (gui--last-selected-text-clipboard, gui--last-selected-text-primary):
+ New vars.
+ (gui-select-text): Rewrite, based on x-win.el's old x-select-text.
+ (gui-select-text-alist, gui-selection-value-alist): Remove.
+ (x-select-request-type): Move from x-win.el.
+ (gui--selection-value-internal): New function, taken from x-win's
+ x-selection-value-internal.
+ (gui-selection-value): Rewrite, based on x-win.el's old x-selection-value.
+ (gui-set-selection-alist): Rename from gui-own-selection-alist and
+ extend it to handle a nil value as a "disown" request.
+ (gui-disown-selection-alist): Remove.
+ (xselect-convert-to-delete): Adjust accordingly.
+ (gui-set-selection): Simplify accordingly as well. Use dotimes.
+
+ * term/x-win.el (x-last-selected-text-primary)
+ (x-select-enable-primary): Remove (moved to select.el).
+ (x-select-request-type): Move to select.el.
+ (x-selection-value-internal, x--selection-value): Remove functions.
+ (gui-selection-value, gui-select-text): Remove moethods.
+ (gui-set-selection): Merge own and disown methods.
+
+ * term/w32-win.el (w32--select-text, w32--get-selection-value):
+ Delete function (move functionality into w32--set-selection and
+ w32--get-selection).
+ (gui-select-text, gui-selection-value): Don't define methods.
+ (w32--set-selection, w32--get-selection, w32--selection-owner-p):
+ New functions.
+ (gui-get-selection, gui-selection-owner-p, gui-selection-exists-p):
+ Use them.
+ (gui-selection-exists-p): Adjust to new name of C primitive.
+
+ * term/pc-win.el (w16-get-selection-value): Add dummy argument and drop
+ test of gui-select-enable-clipboard, to make it usable as
+ a gui-get-selection method.
+ (gui-selection-exists-p): Adjust to new name of C primitive.
+ (gui-set-selection): Merge own and disown methods.
+ (gui-select-text, gui-selection-value): Delete methods.
+ (w16--select-text): Delete function.
+
+ * term/ns-win.el (ns-get-pasteboard, ns-set-pasteboard)
+ (ns-selection-value): Remove functions.
+ (gui-select-text, gui-selection-value): Don't define method any more.
+ (gui-set-selection): Merge the old own and disown methods.
+ (gui-selection-exists-p, gui-get-selection): Adjust to new name of
+ underlying C primitive.
+
+ * startup.el (command-line): Adjust now that `gui-method' expects nil
+ for ttys.
+
+ * frame.el (gui-method): Use window-system rather than framep.
+ (gui-method-declare): The tty case is now nil rather than t.
+ (make-frame): Adjust accordingly.
+
2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
* net/newst-reader.el (newsticker--image-read): Simplify.
(intern (format "%s-alist" base)))
(defmacro gui-method (name &optional type)
- (macroexp-let2 nil type (or type `(framep (selected-frame)))
+ (macroexp-let2 nil type (or type `window-system)
`(alist-get ,type ,(gui-method--name name)
(lambda (&rest _args)
(error "No method %S for %S frame" ',name ,type)))))
(defmacro gui-method-declare (name &optional tty-fun doc)
(declare (doc-string 3) (indent 2))
`(defvar ,(gui-method--name name)
- ,(if tty-fun `(list (cons t ,tty-fun))) ,doc))
+ ,(if tty-fun `(list (cons nil ,tty-fun))) ,doc))
(defmacro gui-call (name &rest args)
`(funcall (gui-method ,name) ,@args))
the new frame according to its own rules."
(interactive)
(let* ((display (cdr (assq 'display parameters)))
- (w (or
- (cond
- ((assq 'terminal parameters)
- (let ((type (terminal-live-p
- (cdr (assq 'terminal parameters)))))
- (cond
- ((null type) (error "Terminal %s does not exist"
- (cdr (assq 'terminal parameters))))
- (t type))))
- ((assq 'window-system parameters)
- (cdr (assq 'window-system parameters)))
- (display
- (or (window-system-for-display display)
- (error "Don't know how to interpret display %S"
- display)))
- (t window-system))
- t))
+ (w (cond
+ ((assq 'terminal parameters)
+ (let ((type (terminal-live-p
+ (cdr (assq 'terminal parameters)))))
+ (cond
+ ((eq t type) nil)
+ ((null type) (error "Terminal %s does not exist"
+ (cdr (assq 'terminal parameters))))
+ (t type))))
+ ((assq 'window-system parameters)
+ (cdr (assq 'window-system parameters)))
+ (display
+ (or (window-system-for-display display)
+ (error "Don't know how to interpret display %S"
+ display)))
+ (t window-system)))
(oldframe (selected-frame))
(params parameters)
frame)
;; Based partially on earlier release by Lucid.
-;; The functionality here is pretty messy, because there are different
-;; functions that claim to get or set the "selection", with no clear
-;; distinction between them. Here's my best understanding of it:
-;; - gui-select-text and gui-selection-value go together to access the general
-;; notion of "GUI selection" for interoperation with other applications.
-;; This can use either the clipboard or the primary selection, or both or
-;; none according to gui-select-enable-clipboard and x-select-enable-primary.
-;; These are the default values of interprogram-cut/paste-function.
-;; - gui-get-primary-selection is used to get the PRIMARY selection,
-;; specifically for mouse-yank-primary.
-;; - gui-get-selection and gui-set-selection are lower-level functions meant to
-;; access various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY).
-
-;; Currently gui-select-text and gui-selection-value provide gui-methods so the
-;; actual backend can do it whichever way it wants. This means for example
-;; that gui-select-enable-clipboard is defined here but implemented in each and
-;; every backend.
-;; Maybe a better structure would be to make gui-select-text and
-;; gui-selection-value have no associated gui-method, and implement
-;; gui-select-enable-clipboard (and x-select-enable-clipboard) themselves.
-;; This would instead rely on gui-get/set-selection being implemented well
-;; (e.g. currently w32's implementation thereof sucks, for example,
-;; since it doesn't access the system's clipboard when setting/getting the
-;; CLIPBOARD selection).
+;; The functionality here is divided in two parts:
+;; - Low-level: gui-get-selection, gui-set-selection, gui-selection-owner-p,
+;; gui-selection-exists-p are the backend-dependent functions meant to access
+;; various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY).
+;; - Higher-level: gui-select-text and gui-selection-value go together to
+;; access the general notion of "GUI selection" for interoperation with other
+;; applications. This can use either the clipboard or the primary selection,
+;; or both or none according to select-enable-clipboard/primary. These are
+;; the default values of interprogram-cut/paste-function.
+;; Additionally, there's gui-get-primary-selection which is used to get the
+;; PRIMARY selection, specifically for mouse-yank-primary.
;;; Code:
;; Only declared obsolete in 23.3.
(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34")
-(defcustom gui-select-enable-clipboard t
+(defcustom select-enable-clipboard t
"Non-nil means cutting and pasting uses the clipboard.
This can be in addition to, but in preference to, the primary selection,
if applicable (i.e. under X11)."
;; The GNU/Linux version changed in 24.1, the MS-Windows version did not.
:version "24.1")
(define-obsolete-variable-alias 'x-select-enable-clipboard
- 'gui-select-enable-clipboard "25.1")
+ 'select-enable-clipboard "25.1")
-(gui-method-declare gui-select-text #'ignore
- "Method used to pass the current selection to the system.
-Called with one argument (the text selected).
-Should obey `gui-select-enable-clipboard' where applicable.")
+(defcustom select-enable-primary nil
+ "Non-nil means cutting and pasting uses the primary selection
+The existence of a primary selection depends on the underlying GUI you use.
+E.g. it doesn't exist under MS-Windows."
+ :type 'boolean
+ :group 'killing
+ :version "24.1")
+(define-obsolete-variable-alias 'x-select-enable-primary
+ 'select-enable-primary "25.1")
-(gui-method-declare gui-get-selection #'ignore
- "Return selected text.
-Called with 2 arguments: (SELECTION-SYMBOL TARGET-TYPE)
-SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-TARGET-TYPE is the type of data desired, typically `STRING'.")
+;; We keep track of the last text selected here, so we can check the
+;; current selection against it, and avoid passing back our own text
+;; from gui-selection-value. We track both
+;; separately in case another X application only sets one of them
+;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same.
-(defvar gui-last-selected-text nil
- ;; We keep track of the last text selected here, so we can check the
- ;; current selection against it, and avoid passing back our own text
- ;; from gui-selection-value.
- "Last text passed to `gui-select-text'.")
+(defvar gui--last-selected-text-clipboard nil
+ "The value of the CLIPBOARD selection last seen.")
+(defvar gui--last-selected-text-primary nil
+ "The value of the PRIMARY selection last seen.")
(defun gui-select-text (text)
"Select TEXT, a string, according to the window system.
-if `gui-select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard.
-
-On X, if `x-select-enable-primary' is non-nil, put TEXT in
-the primary selection.
-
-On MS-Windows, make TEXT the current selection."
- ;; FIXME: We should test gui-select-enable-clipboard here!
- ;; But that would break the independence between x-select-enable-primary
- ;; and x-select-enable-clipboard!
- ;;(when gui-select-enable-clipboard
- (gui-call gui-select-text text) ;;)
- (setq gui-last-selected-text text))
+if `select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard.
+If `select-enable-primary' is non-nil, put TEXT in the primary selection.
+
+MS-Windows does not have a \"primary\" selection."
+ (when select-enable-primary
+ (gui-set-selection 'PRIMARY text)
+ (setq gui--last-selected-text-primary text))
+ (when select-enable-clipboard
+ ;; When cutting, the selection is cleared and PRIMARY
+ ;; set to the empty string. Prevent that, PRIMARY
+ ;; should not be reset by cut (Bug#16382).
+ (setq saved-region-selection text)
+ (gui-set-selection 'CLIPBOARD text)
+ (setq gui--last-selected-text-clipboard text)))
(define-obsolete-function-alias 'x-select-text 'gui-select-text "25.1")
-(gui-method-declare gui-selection-value #'ignore
- "Method to return the GUI's selection.
-Takes no argument, and returns a string.
-Should obey `gui-select-enable-clipboard'.")
+(defcustom x-select-request-type nil
+ "Data type request for X selection.
+The value is one of the following data types, a list of them, or nil:
+ `COMPOUND_TEXT', `UTF8_STRING', `STRING', `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.
+
+The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
+ :type '(choice (const :tag "Default" nil)
+ (const COMPOUND_TEXT)
+ (const UTF8_STRING)
+ (const STRING)
+ (const TEXT)
+ (set :tag "List of values"
+ (const COMPOUND_TEXT)
+ (const UTF8_STRING)
+ (const STRING)
+ (const TEXT)))
+ :group 'killing)
+
+;; Get a selection value of type TYPE by calling gui-get-selection with
+;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
+;; The return value is already decoded. If gui-get-selection causes an
+;; error, this function return nil.
+
+(defun gui--selection-value-internal (type)
+ (let ((request-type (if (eq window-system 'x)
+ (or x-select-request-type
+ '(UTF8_STRING COMPOUND_TEXT STRING))
+ 'STRING))
+ text)
+ (with-demoted-errors "gui-get-selection: %S"
+ (if (consp request-type)
+ (while (and request-type (not text))
+ (setq text (gui-get-selection type (car request-type)))
+ (setq request-type (cdr request-type)))
+ (setq text (gui-get-selection type request-type))))
+ (if text
+ (remove-text-properties 0 (length text) '(foreign-selection nil) text))
+ text))
(defun gui-selection-value ()
- (let ((text (gui-call gui-selection-value)))
- (if (string= text "") (setq text nil))
- (cond
- ((not text) nil)
- ((eq text gui-last-selected-text) nil)
- ((string= text gui-last-selected-text)
- ;; Record the newer string, so subsequent calls can use the `eq' test.
- (setq gui-last-selected-text text)
- nil)
- (t
- (setq gui-last-selected-text text)))))
-(define-obsolete-function-alias 'x-selection-value 'gui-selection-value "25.1")
+ (let ((clip-text
+ (when select-enable-clipboard
+ (let ((text (gui--selection-value-internal 'CLIPBOARD)))
+ (if (string= text "") (setq text nil))
+
+ ;; Check the CLIPBOARD selection for 'newness', is it different
+ ;; from what we remembered them to be last time we did a
+ ;; cut/paste operation.
+ (prog1
+ (unless (equal text gui--last-selected-text-clipboard)
+ text)
+ (setq gui--last-selected-text-clipboard text)))))
+ (primary-text
+ (when select-enable-primary
+ (let ((text (gui--selection-value-internal 'PRIMARY)))
+ (if (string= text "") (setq text nil))
+ ;; Check the PRIMARY selection for 'newness', is it different
+ ;; from what we remembered them to be last time we did a
+ ;; cut/paste operation.
+ (prog1
+ (unless (equal text gui--last-selected-text-primary)
+ text)
+ (setq gui--last-selected-text-primary 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
+ ;; selection from clipboard (if we are supposed to) and primary.
+ ;; So return the first one that has changed
+ ;; (which is the first non-null one).
+ ;;
+ ;; NOTE: There will be cases where more than one of these has
+ ;; changed and the new values differ. This indicates that
+ ;; something like the following has happened since the last time
+ ;; we looked at the selections: Application X set all the
+ ;; selections, then Application Y set only one of them.
+ ;; In this case since we don't have
+ ;; timestamps there is no way to know what the 'correct' value to
+ ;; return is. The nice thing to do would be to tell the user we
+ ;; saw multiple possible selections and ask the user which was the
+ ;; one they wanted.
+ (or clip-text primary-text)
+ ))
-(defun gui-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.
-
-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. This argument is
-ignored on MS-Windows and MS-DOS."
- (let ((data (gui-call gui-get-selection (or type 'PRIMARY)
- (or data-type 'STRING))))
- (when (and (stringp data)
- (setq data-type (get-text-property 0 'foreign-selection data)))
- (let ((coding (or next-selection-coding-system
- selection-coding-system
- (pcase data-type
- ('UTF8_STRING 'utf-8)
- ('COMPOUND_TEXT 'compound-text-with-extensions)
- ('C_STRING nil)
- ('STRING 'iso-8859-1)
- (_ (error "Unknown selection data type: %S"
- type))))))
- (setq data (if coding (decode-coding-string data coding)
- (string-to-multibyte data))))
- (setq next-selection-coding-system nil)
- (put-text-property 0 (length data) 'foreign-selection data-type data))
- data))
-(define-obsolete-function-alias 'x-get-selection 'gui-get-selection "25.1")
+(define-obsolete-function-alias 'x-selection-value 'gui-selection-value "25.1")
(defun x-get-clipboard ()
"Return text pasted to the clipboard."
(define-obsolete-function-alias 'x-get-selection-value
'gui-get-primary-selection "25.1")
-(gui-method-declare gui-own-selection nil
+;;; Lower-level, backend dependent selection handling.
+
+(gui-method-declare gui-get-selection #'ignore
+ "Return selected text.
+Called with 2 arguments: (SELECTION-SYMBOL TARGET-TYPE)
+SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)
+TARGET-TYPE is the type of data desired, typically `STRING'.")
+
+(gui-method-declare gui-set-selection nil
"Method to assert a selection of type SELECTION and value VALUE.
SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-(Those are literal upper-case symbol names, since that's what X expects.)
+If VALUE is nil and we own the selection SELECTION, disown it instead.
+Disowning it means there is no such selection.
+\(Those are literal upper-case symbol names, since that's what X expects.)
VALUE is typically a string, or a cons of two markers, but may be
anything that the functions on `selection-converter-alist' know about.
Called with 2 args: (SELECTION VALUE).")
-(gui-method-declare gui-disown-selection nil
- "If we own the selection SELECTION, disown it.
-Disowning it means there is no such selection.
-
-Called with one argument: (SELECTION)")
-
(gui-method-declare gui-selection-owner-p #'ignore
"Whether the current Emacs process owns the given X Selection.
Called with one argument: (SELECTION).
The arg should be the name of the selection in question, typically one of
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-(Those are literal upper-case symbol names, since that's what X expects.)")
+\(Those are literal upper-case symbol names, since that's what X expects.)")
(gui-method-declare gui-selection-exists-p #'ignore
"Whether there is an owner for the given X Selection.
Called with one argument: (SELECTION).
The arg should be the name of the selection in question, typically one of
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-(Those are literal upper-case symbol names, since that's what X expects.)")
+\(Those are literal upper-case symbol names, since that's what X expects.)")
+
+(defun gui-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.
+
+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. This argument is
+ignored on MS-Windows and MS-DOS."
+ (let ((data (gui-call gui-get-selection (or type 'PRIMARY)
+ (or data-type 'STRING))))
+ (when (and (stringp data)
+ (setq data-type (get-text-property 0 'foreign-selection data)))
+ (let ((coding (or next-selection-coding-system
+ selection-coding-system
+ (pcase data-type
+ ('UTF8_STRING 'utf-8)
+ ('COMPOUND_TEXT 'compound-text-with-extensions)
+ ('C_STRING nil)
+ ('STRING 'iso-8859-1)
+ (_ (error "Unknown selection data type: %S"
+ type))))))
+ (setq data (if coding (decode-coding-string data coding)
+ (string-to-multibyte data))))
+ (setq next-selection-coding-system nil)
+ (put-text-property 0 (length data) 'foreign-selection data-type data))
+ data))
+(define-obsolete-function-alias 'x-get-selection 'gui-get-selection "25.1")
(defun gui-set-selection (type data)
"Make an X selection of type TYPE and value DATA.
(if (stringp type) (setq type (intern type)))
(or (gui--valid-simple-selection-p data)
(and (vectorp data)
- (let ((valid t)
- (i (1- (length data))))
- (while (>= i 0)
+ (let ((valid t))
+ (dotimes (i (length data))
(or (gui--valid-simple-selection-p (aref data i))
- (setq valid nil))
- (setq i (1- i)))
+ (setq valid nil)))
valid))
(signal 'error (list "invalid selection" data)))
(or type (setq type 'PRIMARY))
- (if data
- (gui-call gui-own-selection type data)
- (gui-call gui-disown-selection type))
+ (gui-call gui-set-selection type data)
data)
(define-obsolete-function-alias 'x-set-selection 'gui-set-selection "25.1")
(markerp (car data))
(markerp (cdr data))
(marker-buffer (car data))
- (buffer-name (marker-buffer (car data)))
+ (buffer-live-p (marker-buffer (car data)))
(eq (marker-buffer (car data))
(marker-buffer (cdr data))))
(stringp data)
(and (overlayp data)
(overlay-buffer data)
- (buffer-name (overlay-buffer data)))
+ (buffer-live-p (overlay-buffer data)))
(symbolp data)
(integerp data)))
\f
(apply 'vector all)))
(defun xselect-convert-to-delete (selection _type _value)
- (gui-call gui-disown-selection selection)
+ (gui-call gui-set-selection selection nil)
;; 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.
((car (posn-x-y posn))
(setq temporary-goal-column
(cons (/ (float (car (posn-x-y posn)))
- (frame-char-width)) hscroll))))))
+ (frame-char-width))
+ hscroll))))))
(if target-hscroll
(set-window-hscroll (selected-window) target-hscroll))
;; vertical-motion can move more than it was asked to if it moves
;; Process window-system specific command line parameters.
(setq command-line-args
(funcall
- (gui-method handle-args-function (or initial-window-system t))
+ (gui-method handle-args-function initial-window-system)
command-line-args))
;; Initialize the window system. (Open connection, etc.)
(funcall
- (gui-method window-system-initialization (or initial-window-system t)))
+ (gui-method window-system-initialization initial-window-system))
(put initial-window-system 'window-system-initialized t))
;; If there was an error, print the error message and exit.
(error
'ns-store-selection-internal "24.1")
-(defun ns-get-pasteboard ()
- "Returns the value of the pasteboard."
- (ns-get-selection-internal 'CLIPBOARD))
-
-(defun ns-set-pasteboard (string)
- "Store STRING into the pasteboard of the Nextstep display server."
- ;; Check the data type of STRING.
- (if (not (stringp string)) (error "Nonstring given to pasteboard"))
- (ns-store-selection-internal 'CLIPBOARD string))
-
-;; Return the value of the current Nextstep selection. For
-;; compatibility with older Nextstep applications, this checks cut
-;; buffer 0 before retrieving the value of the primary selection.
-(gui-method-define gui-selection-value ns #'ns-selection-value)
-(defun ns-selection-value ()
- ;; Consult the selection. Treat empty strings as if they were unset.
- (if gui-select-enable-clipboard
- (ns-get-pasteboard)))
-
(defun ns-copy-including-secondary ()
(interactive)
(call-interactively 'kill-ring-save)
(gui-method-define window-system-initialization ns
#'ns-initialize-window-system)
-(declare-function ns-set-pasteboard "ns-win" (string))
-(gui-method-define gui-select-text ns
- (lambda (text)
- ;; Don't send the pasteboard too much text.
- ;; It becomes slow, and if really big it causes errors.
- (when gui-select-enable-clipboard
- (ns-set-pasteboard text))))
-
-(gui-method-define gui-own-selection ns #'ns-own-selection-internal)
-(gui-method-define gui-disown-selection ns #'ns-disown-selection-internal)
+(gui-method-define gui-set-selection ns
+ (lambda (selection value)
+ (if value (ns-own-selection-internal selection value)
+ (ns-disown-selection-internal selection))))
(gui-method-define gui-selection-owner-p ns #'ns-selection-owner-p)
-(gui-method-define gui-selection-exists-p ns #'x-selection-exists-p)
-(gui-method-define gui-get-selection ns #'x-get-selection-internal) ;FIXME:name!
+(gui-method-define gui-selection-exists-p ns #'ns-selection-exists-p)
+(gui-method-define gui-get-selection ns #'ns-get-selection)
(provide 'ns-win)
;
;;;; Selections
;
-(defun w16-get-selection-value ()
+(defun w16-get-selection-value (_selection-symbol _target-type)
"Return the value of the current selection.
Consult the selection. Treat empty strings as if they were unset."
- (if gui-select-enable-clipboard
- ;; Don't die if x-get-selection signals an error.
- (with-demoted-errors "w16-get-clipboard-data:%s"
- (w16-get-clipboard-data))))
+ ;; Don't die if x-get-selection signals an error.
+ (with-demoted-errors "w16-get-clipboard-data:%s"
+ (w16-get-clipboard-data)))
;; gui-selection-owner-p is used in simple.el.
-(gui-method-define gui-selection-exists-p pc #'x-selection-exists-p)
+(gui-method-define gui-selection-exists-p pc #'w16-selection-exists-p)
(gui-method-define gui-selection-owner-p pc #'w16-selection-owner-p)
(defun w16-selection-owner-p (_selection)
;; FIXME: Other systems don't obey gui-select-enable-clipboard here.
text)
(t nil)))))
-;; gui-own-selection and gui-disown-selection are used in gui-set-selection.
-(gui-method-define gui-own-selection pc
- (lambda (_selection value)
- ;; FIXME: Other systems don't obey
- ;; gui-select-enable-clipboard here.
- (ignore-errors
- (w16--select-text value))
- value))
-
-(gui-method-define gui-disown-selection pc
- (lambda (selection &optional _time-object _terminal)
- (if (w16-selection-owner-p selection)
- t)))
+;; gui-set-selection is used in gui-set-selection.
+(declare-function w16-set-clipboard-data "w16select.c"
+ (string &optional ignored))
+(gui-method-define gui-set-selection pc
+ (lambda (selection value)
+ (if (not value)
+ (if (w16-selection-owner-p selection)
+ t)
+ ;; FIXME: Other systems don't obey
+ ;; gui-select-enable-clipboard here.
+ (with-demoted-errors "w16-set-clipboard-data: %S"
+ (w16-set-clipboard-data value))
+ value)))
;; gui-get-selection is used in select.el
-(gui-method-define gui-get-selection pc
- (lambda (selection-symbol target-type)
- (w16-get-selection-value)))
+(gui-method-define gui-get-selection pc #'w16-get-selection-value)
;; From src/fontset.c:
(fset 'query-fontset 'ignore)
(gui-method-define handle-args-function pc #'tty-handle-args)
-(declare-function w16-set-clipboard-data "w16select.c"
- (string &optional ignored))
-(gui-method-define gui-select-text pc #'w16--select-text)
-(gui-method-define gui-selection-value pc #'w16-get-selection-value)
-(defun w16--select-text (text)
- (when gui-select-enable-clipboard
- (w16-set-clipboard-data text)))
;; ---------------------------------------------------------------------------
(string &optional ignored))
(declare-function w32-get-clipboard-data "w32select.c")
-(defun w32--select-text (text)
- (if gui-select-enable-clipboard (w32-set-clipboard-data text)))
-
-(defun w32--get-selection-value ()
- "Return the value of the current selection.
-Consult the selection. Treat empty strings as if they were unset."
- (if gui-select-enable-clipboard
- ;; Don't die if x-get-selection signals an error.
+;;; Fix interface to (X-specific) mouse.el
+(defun w32--set-selection (type value)
+ (if (eq type 'CLIPBOARD)
+ (w32-set-clipboard-data text)
+ (put 'x-selections (or type 'PRIMARY) data)))
+
+(defun w32--get-selection (&optional type data-type)
+ (if (and (eq type 'CLIPBOARD)
+ (eq data-type 'STRING))
(with-demoted-errors "w32-get-clipboard-data:%S"
- (w32-get-clipboard-data))))
+ (w32-get-clipboard-data))
+ (get 'x-selections (or type 'PRIMARY))))
+
+(defun w32--selection-owner-p (selection)
+ (and (memq selection '(nil PRIMARY SECONDARY))
+ (get 'x-selections (or selection 'PRIMARY))))
+
+(gui-method-define gui-set-selection w32 #'w32--set-selection)
+(gui-method-define gui-get-selection w32 #'w32--get-selection)
-;; Arrange for the kill and yank functions to set and check the clipboard.
-(gui-method-define gui-select-text w32 #'w32--select-text)
-(gui-method-define gui-selection-value w32 #'w32--get-selection-value)
+(gui-method-define gui-selection-owner-p w32 #'w32--selection-owner-p)
+(gui-method-define gui-selection-exists-p w32 #'w32-selection-exists-p)
(when (eq system-type 'windows-nt)
;; Make copy&pasting in w32's console interact with the system's clipboard!
- (gui-method-define gui-select-text t #'w32--select-text)
- (gui-method-define gui-selection-value t #'w32--get-selection-value))
-
-;;; Fix interface to (X-specific) mouse.el
-(gui-method-define gui-own-selection w32
- (lambda (type value)
- (put 'x-selections (or type 'PRIMARY) data)))
-
-(gui-method-define gui-disown-selection w32
- (lambda (type)
- (put 'x-selections (or type 'PRIMARY) nil)))
-
-(gui-method-define gui-get-selection w32
- (lambda (&optional type _data-type)
- (get 'x-selections (or type 'PRIMARY))))
-
-;; gui-selection-owner-p is used in simple.el
-(gui-method-define gui-selection-owner-p w32
- (lambda (selection)
- (and (memq selection '(nil PRIMARY SECONDARY))
- (get 'x-selections (or selection 'PRIMARY)))))
-(gui-method-define gui-selection-exists-p w32 #'x-selection-exists-p)
+ (gui-method-define gui-set-selection nil #'w32--set-selection)
+ (gui-method-define gui-get-selection nil #'w32--get-selection)
+ (gui-method-define gui-selection-owner-p nil #'w32--selection-owner-p)
+ (gui-method-define gui-selection-exists-p nil #'w32-selection-exists-p))
;; The "Windows" keys on newer keyboards bring up the Start menu
;; whether you want it or not - make Emacs ignore these keystrokes
\f
;;;; Selections
-;; We keep track of the last text selected here, so we can check the
-;; current selection against it, and avoid passing back our own text
-;; from x--selection-value. We track both
-;; separately in case another X application only sets one of them
-;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same.
-(defvar x-last-selected-text-clipboard nil
- "The value of the CLIPBOARD X selection last time we selected or
-pasted text.")
-(defvar x-last-selected-text-primary nil
- "The value of the PRIMARY X selection last time we selected or
-pasted text.")
-
-(defcustom x-select-enable-primary nil
- "Non-nil means cutting and pasting uses the primary selection."
- :type 'boolean
- :group 'killing
- :version "24.1")
-
-(defcustom x-select-request-type nil
- "Data type request for X selection.
-The value is one of the following data types, a list of them, or nil:
- `COMPOUND_TEXT', `UTF8_STRING', `STRING', `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.
-
-The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
- :type '(choice (const :tag "Default" nil)
- (const COMPOUND_TEXT)
- (const UTF8_STRING)
- (const STRING)
- (const TEXT)
- (set :tag "List of values"
- (const COMPOUND_TEXT)
- (const UTF8_STRING)
- (const STRING)
- (const TEXT)))
- :group 'killing)
-
-;; Get a selection value of type TYPE by calling x-get-selection with
-;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
-;; The return value is already decoded. If x-get-selection causes an
-;; error, this function return nil.
-
-(defun x-selection-value-internal (type)
- (let ((request-type (or x-select-request-type
- '(UTF8_STRING COMPOUND_TEXT STRING)))
- text)
- (if (consp request-type)
- (while (and request-type (not text))
- (condition-case nil
- (setq text (x-get-selection type (car request-type)))
- (error nil))
- (setq request-type (cdr request-type)))
- (condition-case nil
- (setq text (x-get-selection type 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.
-;; Consult the selection. Treat empty strings as if they were unset.
-;; If this function is called twice and finds the same text,
-;; it returns nil the second time. This is so that a single
-;; selection won't be added to the kill ring over and over.
-(gui-method-define gui-selection-value x #'x--selection-value)
-(defun x--selection-value ()
- ;; With multi-tty, this function may be called from a tty frame.
- (let (clip-text primary-text)
- (when x-select-enable-clipboard
- (setq clip-text (x-selection-value-internal 'CLIPBOARD))
- (if (string= clip-text "") (setq clip-text nil))
-
- ;; Check the CLIPBOARD selection for 'newness', is it different
- ;; from what we remembered them to be last time we did a
- ;; cut/paste operation.
- (setq clip-text
- (cond ;; check clipboard
- ((or (not clip-text) (string= clip-text ""))
- (setq x-last-selected-text-clipboard nil))
- ((eq clip-text x-last-selected-text-clipboard) nil)
- ((string= clip-text x-last-selected-text-clipboard)
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- (setq x-last-selected-text-clipboard clip-text)
- nil)
- (t (setq x-last-selected-text-clipboard clip-text)))))
-
- (when x-select-enable-primary
- (setq primary-text (x-selection-value-internal 'PRIMARY))
- ;; Check the PRIMARY selection for 'newness', is it different
- ;; from what we remembered them to be last time we did a
- ;; cut/paste operation.
- (setq primary-text
- (cond ;; check primary selection
- ((or (not primary-text) (string= primary-text ""))
- (setq x-last-selected-text-primary nil))
- ((eq primary-text x-last-selected-text-primary) nil)
- ((string= primary-text x-last-selected-text-primary)
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- (setq x-last-selected-text-primary primary-text)
- nil)
- (t
- (setq x-last-selected-text-primary primary-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
- ;; selection from clipboard (if we are supposed to) and primary.
- ;; So return the first one that has changed
- ;; (which is the first non-null one).
- ;;
- ;; NOTE: There will be cases where more than one of these has
- ;; changed and the new values differ. This indicates that
- ;; something like the following has happened since the last time
- ;; we looked at the selections: Application X set all the
- ;; selections, then Application Y set only one of them.
- ;; In this case since we don't have
- ;; timestamps there is no way to know what the 'correct' value to
- ;; return is. The nice thing to do would be to tell the user we
- ;; saw multiple possible selections and ask the user which was the
- ;; one they wanted.
- (or clip-text primary-text)
- ))
-
(define-obsolete-function-alias 'x-cut-buffer-or-selection-value
'x-selection-value "24.1")
(gui-method-define frame-creation-function x #'x-create-frame-with-faces)
(gui-method-define window-system-initialization x #'x-initialize-window-system)
-(defvar x-select-enable-primary) ; x-win.el
-(gui-method-define gui-select-text x
- (lambda (text)
- (when x-select-enable-primary
- (gui-set-selection 'PRIMARY text)
- (setq x-last-selected-text-primary text))
- (when x-select-enable-clipboard
- ;; When cutting, the selection is cleared and PRIMARY
- ;; set to the empty string. Prevent that, PRIMARY
- ;; should not be reset by cut (Bug#16382).
- (setq saved-region-selection text)
- (gui-set-selection 'CLIPBOARD text)
- (setq x-last-selected-text-clipboard text))))
-(gui-method-define gui-own-selection x #'x-own-selection-internal)
-(gui-method-define gui-disown-selection x #'x-disown-selection-internal)
+(gui-method-define gui-set-selection x
+ (lambda (selection value)
+ (if value (x-own-selection-internal selection value)
+ (x-disown-selection-internal selection))))
(gui-method-define gui-selection-owner-p x #'x-selection-owner-p)
(gui-method-define gui-selection-exists-p x #'x-selection-exists-p)
(gui-method-define gui-get-selection x #'x-get-selection-internal)
+2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * w32select.c (Fw32_selection_exists_p): Rename from
+ Fx_selection_exists_p.
+ (syms_of_w32select): Adjust accordingly.
+
+ * w16select.c (Fw16_selection_exists_p): Rename from
+ Fx_selection_exists_p.
+ (syms_of_win16select): Adjust accordingly.
+
+ * nsselect.m (ns_get_local_selection): Signal error rather than `quit'.
+ (Fns_own_selection_internal): Tighten scoping.
+ (Fns_selection_exists_p): Rename from Fx_selection_exists_p.
+ (Fns_get_selection): Rename from Fx_get_selection_internal.
+ (Fns_get_selection_internal, Fns_store_selection_internal):
+ Remove functions.
+ (syms_of_nsselect): Adjust accordingly.
+
2014-10-21 Martin Rudalics <rudalics@gmx.at>
* w32fns.c (Fw32_frame_menu_bar_size): New function.
*/
/* This should be the first include, as it may set up #defines affecting
- interpretation of even the system includes. */
+ interpretation of even the system includes. */
#include <config.h>
#include "lisp.h"
length: SBYTES (str)
encoding: NSUTF8StringEncoding
freeWhenDone: NO];
+ // FIXME: Why those 2 different code paths?
if (gtype == nil)
{
+ // Used for ns-store-selection-internal.
[pb declareTypes: ns_send_types owner: nil];
tenum = [ns_send_types objectEnumerator];
while ( (type = [tenum nextObject]) )
}
else
{
+ // Used for ns-own-selection-internal.
+ eassert (type == NSStringPboardType);
[pb setString: nsStr forType: gtype];
}
[nsStr release];
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, check;
- ptrdiff_t count;
+ ptrdiff_t count = specpdl_ptr - specpdl;
local_value = assq_no_quit (selection_name, Vselection_alist);
if (NILP (local_value)) return Qnil;
- count = specpdl_ptr - specpdl;
specbind (Qinhibit_quit, Qt);
CHECK_SYMBOL (target_type);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
if (CONSP (check)
&& INTEGERP (XCAR (check))
- && (INTEGERP (XCDR (check))||
- (CONSP (XCDR (check))
- && INTEGERP (XCAR (XCDR (check)))
- && NILP (XCDR (XCDR (check))))))
+ && (INTEGERP (XCDR (check))
+ || (CONSP (XCDR (check))
+ && INTEGERP (XCAR (XCDR (check)))
+ && NILP (XCDR (XCDR (check))))))
return value;
- // FIXME: Why `quit' rather than `error'?
- Fsignal (Qquit,
+ Fsignal (Qerror,
list3 (build_string ("invalid data returned by"
" selection-conversion function"),
handler_fn, value));
- // FIXME: Beware, `quit' can return!!
- return Qnil;
}
(Lisp_Object selection, Lisp_Object value)
{
id pb;
- Lisp_Object old_value, new_value;
NSString *type;
Lisp_Object successful_p = Qnil, rest;
Lisp_Object target_symbol, data;
if (pb == nil) return Qnil;
ns_declare_pasteboard (pb);
- old_value = assq_no_quit (selection, Vselection_alist);
- new_value = list2 (selection, value);
+ {
+ Lisp_Object old_value = assq_no_quit (selection, Vselection_alist);
+ Lisp_Object new_value = list2 (selection, value);
- if (NILP (old_value))
- Vselection_alist = Fcons (new_value, Vselection_alist);
- else
- Fsetcdr (old_value, Fcdr (new_value));
+ if (NILP (old_value))
+ Vselection_alist = Fcons (new_value, Vselection_alist);
+ else
+ Fsetcdr (old_value, Fcdr (new_value));
+ }
/* We only support copy of text. */
type = NSStringPboardType;
if (!EQ (Vns_sent_selection_hooks, Qunbound))
{
+ /* FIXME: Use run-hook-with-args! */
for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
call3 (Fcar (rest), selection, target_symbol, successful_p);
}
}
-DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
+DEFUN ("ns-selection-exists-p", Fns_selection_exists_p, Sns_selection_exists_p,
0, 2, 0, doc: /* Whether there is an owner for the given X selection.
SELECTION should be the name of the selection in question, typically
one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
}
-DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
- Sx_get_selection_internal, 2, 4, 0,
+DEFUN ("ns-get-selection", Fns_get_selection,
+ Sns_get_selection, 2, 4, 0,
doc: /* Return text selected from some X window.
SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
\(Those are literal upper-case symbol names, since that's what X expects.)
}
-DEFUN ("ns-get-selection-internal", Fns_get_selection_internal,
- Sns_get_selection_internal, 1, 1, 0,
- doc: /* Returns the value of SELECTION as a string.
-SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */)
- (Lisp_Object selection)
-{
- id pb;
- check_window_system (NULL);
- pb = ns_symbol_to_pb (selection);
- return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
-}
-
-
-DEFUN ("ns-store-selection-internal", Fns_store_selection_internal,
- Sns_store_selection_internal, 2, 2, 0,
- doc: /* Sets the string value of SELECTION.
-SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */)
- (Lisp_Object selection, Lisp_Object string)
-{
- id pb;
- check_window_system (NULL);
- pb = ns_symbol_to_pb (selection);
- if (pb != nil) ns_string_to_pasteboard (pb, string);
- return Qnil;
-}
-
-
void
nxatoms_of_nsselect (void)
{
QFILE_NAME = intern_c_string ("FILE_NAME"); staticpro (&QFILE_NAME);
defsubr (&Sns_disown_selection_internal);
- defsubr (&Sx_get_selection_internal);
+ defsubr (&Sns_get_selection);
defsubr (&Sns_own_selection_internal);
- defsubr (&Sx_selection_exists_p);
+ defsubr (&Sns_selection_exists_p);
defsubr (&Sns_selection_owner_p);
- defsubr (&Sns_get_selection_internal);
- defsubr (&Sns_store_selection_internal);
Vselection_alist = Qnil;
staticpro (&Vselection_alist);
return (ret);
}
-/* Support checking for a clipboard selection. */
+/* Support checking for a clipboard selection. */
-DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
+DEFUN ("w16-selection-exists-p", Fw16_selection_exists_p, Sw16_selection_exists_p,
0, 2, 0,
doc: /* Whether there is an owner for the given X selection.
SELECTION should be the name of the selection in question, typically
{
defsubr (&Sw16_set_clipboard_data);
defsubr (&Sw16_get_clipboard_data);
- defsubr (&Sx_selection_exists_p);
+ defsubr (&Sw16_selection_exists_p);
DEFVAR_LISP ("selection-coding-system", Vselection_coding_system,
doc: /* Coding system for communicating with other programs.
return (ret);
}
-/* Support checking for a clipboard selection. */
+/* Support checking for a clipboard selection. */
-DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
+DEFUN ("w32-selection-exists-p", Fw32_selection_exists_p, Sw32_selection_exists_p,
0, 2, 0,
doc: /* Whether there is an owner for the given X selection.
SELECTION should be the name of the selection in question, typically
CHECK_SYMBOL (selection);
/* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check
- if the clipboard currently has valid text format contents. */
+ if the clipboard currently has valid text format contents. */
if (EQ (selection, QCLIPBOARD))
{
}
/* One-time init. Called in the un-dumped Emacs, but not in the
- dumped version. */
+ dumped version. */
void
syms_of_w32select (void)
{
defsubr (&Sw32_set_clipboard_data);
defsubr (&Sw32_get_clipboard_data);
- defsubr (&Sx_selection_exists_p);
+ defsubr (&Sw32_selection_exists_p);
DEFVAR_LISP ("selection-coding-system", Vselection_coding_system,
doc: /* Coding system for communicating with other programs.
projects / emacs.git / commitdiff