mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-27 10:54:40 +00:00
Code Issues Releases Activity

Get rid of backend-dependent selection-handling functions for kill/yank

Browse Source 
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.

* lisp/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.

* lisp/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.

* lisp/startup.el (command-line): Adjust now that `gui-method' expects nil
for ttys.

* lisp/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.

* lisp/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.

* lisp/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.

* src/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.

* src/w16select.c (Fw16_selection_exists_p): Rename from
Fx_selection_exists_p.
(syms_of_win16select): Adjust accordingly.

* src/w32select.c (Fw32_selection_exists_p): Rename from
Fx_selection_exists_p.
(syms_of_w32select): Adjust accordingly.
This commit is contained in:
Stefan Monnier 2014-10-21 11:27:18 -04:00
parent e5b3b7d3f3
commit a046b8dd48
14 changed files with 386 additions and 447 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
etc/NEWS
View File

@ -49,8 +49,12 @@ Use './configure PKG_CONFIG=/full/name/of/pkg-config' if you need to.
* Changes in Emacs 25.1 * Changes in Emacs 25.1
** x-select-enable-clipboard is renamed gui-select-enable-clipboard. ** x-select-enable-clipboard is renamed select-enable-clipboard.
Additionally it now also applies to OSX and GNUstep. 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. ** terpri gets an optional arg ENSURE to conditionally output a newline.

64
lisp/ChangeLog
View File

@ -1,3 +1,67 @@
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> 2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
* net/newst-reader.el (newsticker--image-read): Simplify. * net/newst-reader.el (newsticker--image-read): Simplify.

37
lisp/frame.el
View File

@ -32,7 +32,7 @@
(intern (format "%s-alist" base))) (intern (format "%s-alist" base)))
(defmacro gui-method (name &optional type) (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) `(alist-get ,type ,(gui-method--name name)
(lambda (&rest _args) (lambda (&rest _args)
(error "No method %S for %S frame" ',name ,type))))) (error "No method %S for %S frame" ',name ,type)))))
@ -43,7 +43,7 @@
(defmacro gui-method-declare (name &optional tty-fun doc) (defmacro gui-method-declare (name &optional tty-fun doc)
(declare (doc-string 3) (indent 2)) (declare (doc-string 3) (indent 2))
`(defvar ,(gui-method--name name) `(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) (defmacro gui-call (name &rest args)
`(funcall (gui-method ,name) ,@args)) `(funcall (gui-method ,name) ,@args))
@ -646,23 +646,22 @@ frame the selected frame. However, the window system may select
the new frame according to its own rules." the new frame according to its own rules."
(interactive) (interactive)
(let* ((display (cdr (assq 'display parameters))) (let* ((display (cdr (assq 'display parameters)))
(w (or (w (cond
(cond ((assq 'terminal parameters)
((assq 'terminal parameters) (let ((type (terminal-live-p
(let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
(cdr (assq 'terminal parameters))))) (cond
(cond ((eq t type) nil)
((null type) (error "Terminal %s does not exist" ((null type) (error "Terminal %s does not exist"
(cdr (assq 'terminal parameters)))) (cdr (assq 'terminal parameters))))
(t type)))) (t type))))
((assq 'window-system parameters) ((assq 'window-system parameters)
(cdr (assq 'window-system parameters))) (cdr (assq 'window-system parameters)))
(display (display
(or (window-system-for-display display) (or (window-system-for-display display)
(error "Don't know how to interpret display %S" (error "Don't know how to interpret display %S"
display))) display)))
(t window-system)) (t window-system)))
t))
(oldframe (selected-frame)) (oldframe (selected-frame))
(params parameters) (params parameters)
frame) frame)

316
lisp/select.el
View File

@ -24,30 +24,17 @@
;; Based partially on earlier release by Lucid. ;; Based partially on earlier release by Lucid.
;; The functionality here is pretty messy, because there are different ;; The functionality here is divided in two parts:
;; functions that claim to get or set the "selection", with no clear ;; - Low-level: gui-get-selection, gui-set-selection, gui-selection-owner-p,
;; distinction between them. Here's my best understanding of it: ;; gui-selection-exists-p are the backend-dependent functions meant to access
;; - gui-select-text and gui-selection-value go together to access the general ;; various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY).
;; notion of "GUI selection" for interoperation with other applications. ;; - Higher-level: gui-select-text and gui-selection-value go together to
;; This can use either the clipboard or the primary selection, or both or ;; access the general notion of "GUI selection" for interoperation with other
;; none according to gui-select-enable-clipboard and x-select-enable-primary. ;; applications. This can use either the clipboard or the primary selection,
;; These are the default values of interprogram-cut/paste-function. ;; or both or none according to select-enable-clipboard/primary. These are
;; - gui-get-primary-selection is used to get the PRIMARY selection, ;; the default values of interprogram-cut/paste-function.
;; specifically for mouse-yank-primary. ;; Additionally, there's gui-get-primary-selection which is used to get the
;; - gui-get-selection and gui-set-selection are lower-level functions meant to ;; PRIMARY selection, specifically for mouse-yank-primary.
;; 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).
;;; Code: ;;; Code:
@ -99,7 +86,7 @@ After the communication, this variable is set to nil.")
;; Only declared obsolete in 23.3. ;; Only declared obsolete in 23.3.
(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") (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. "Non-nil means cutting and pasting uses the clipboard.
This can be in addition to, but in preference to, the primary selection, This can be in addition to, but in preference to, the primary selection,
if applicable (i.e. under X11)." if applicable (i.e. under X11)."
@ -108,12 +95,158 @@ if applicable (i.e. under X11)."
;; The GNU/Linux version changed in 24.1, the MS-Windows version did not. ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not.
:version "24.1") :version "24.1")
(define-obsolete-variable-alias 'x-select-enable-clipboard (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 (defcustom select-enable-primary nil
"Method used to pass the current selection to the system. "Non-nil means cutting and pasting uses the primary selection
Called with one argument (the text selected). The existence of a primary selection depends on the underlying GUI you use.
Should obey `gui-select-enable-clipboard' where applicable.") 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")
;; 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-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 `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")
(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 ((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)
))
(define-obsolete-function-alias 'x-selection-value 'gui-selection-value "25.1")
(defun x-get-clipboard ()
"Return text pasted to the clipboard."
(declare (obsolete gui-get-selection "25.1"))
(gui-call gui-get-selection 'CLIPBOARD 'STRING))
(defun gui-get-primary-selection ()
"Return the PRIMARY selection, or the best emulation thereof."
(or (gui-get-selection 'PRIMARY)
(and (fboundp 'w32-get-selection-value)
(eq (framep (selected-frame)) 'w32)
;; MS-Windows emulates PRIMARY in x-get-selection, but only
;; within the Emacs session, so consult the clipboard if
;; primary is not found.
(w32-get-selection-value))
(error "No selection is available")))
(define-obsolete-function-alias 'x-get-selection-value
'gui-get-primary-selection "25.1")
;;; Lower-level, backend dependent selection handling.
(gui-method-declare gui-get-selection #'ignore (gui-method-declare gui-get-selection #'ignore
"Return selected text. "Return selected text.
@ -122,46 +255,30 @@ SELECTION-SYMBOL is typically `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.)
TARGET-TYPE is the type of data desired, typically `STRING'.") TARGET-TYPE is the type of data desired, typically `STRING'.")
(defvar gui-last-selected-text nil (gui-method-declare gui-set-selection nil
;; We keep track of the last text selected here, so we can check the "Method to assert a selection of type SELECTION and value VALUE.
;; current selection against it, and avoid passing back our own text SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
;; from gui-selection-value. If VALUE is nil and we own the selection SELECTION, disown it instead.
"Last text passed to `gui-select-text'.") 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.
(defun gui-select-text (text) Called with 2 args: (SELECTION VALUE).")
"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 (gui-method-declare gui-selection-owner-p #'ignore
the primary selection. "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.)")
On MS-Windows, make TEXT the current selection." (gui-method-declare gui-selection-exists-p #'ignore
;; FIXME: We should test gui-select-enable-clipboard here! "Whether there is an owner for the given X Selection.
;; But that would break the independence between x-select-enable-primary Called with one argument: (SELECTION).
;; and x-select-enable-clipboard! The arg should be the name of the selection in question, typically one of
;;(when gui-select-enable-clipboard the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
(gui-call gui-select-text text) ;;) \(Those are literal upper-case symbol names, since that's what X expects.)")
(setq gui-last-selected-text 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'.")
(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")
(defun gui-get-selection (&optional type data-type) (defun gui-get-selection (&optional type data-type)
"Return the value of an X Windows selection. "Return the value of an X Windows selection.
@ -197,53 +314,6 @@ ignored on MS-Windows and MS-DOS."
data)) data))
(define-obsolete-function-alias 'x-get-selection 'gui-get-selection "25.1") (define-obsolete-function-alias 'x-get-selection 'gui-get-selection "25.1")
(defun x-get-clipboard ()
"Return text pasted to the clipboard."
(declare (obsolete gui-get-selection "25.1"))
(gui-call gui-get-selection 'CLIPBOARD 'STRING))
(defun gui-get-primary-selection ()
"Return the PRIMARY selection, or the best emulation thereof."
(or (gui-get-selection 'PRIMARY)
(and (fboundp 'w32-get-selection-value)
(eq (framep (selected-frame)) 'w32)
;; MS-Windows emulates PRIMARY in x-get-selection, but only
;; within the Emacs session, so consult the clipboard if
;; primary is not found.
(w32-get-selection-value))
(error "No selection is available")))
(define-obsolete-function-alias 'x-get-selection-value
'gui-get-primary-selection "25.1")
(gui-method-declare gui-own-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.)
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.)")
(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.)")
(defun gui-set-selection (type data) (defun gui-set-selection (type data)
"Make an X 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 The argument TYPE (nil means `PRIMARY') says which selection, and
@ -274,18 +344,14 @@ are not available to other programs."
(if (stringp type) (setq type (intern type))) (if (stringp type) (setq type (intern type)))
(or (gui--valid-simple-selection-p data) (or (gui--valid-simple-selection-p data)
(and (vectorp data) (and (vectorp data)
(let ((valid t) (let ((valid t))
(i (1- (length data)))) (dotimes (i (length data))
(while (>= i 0)
(or (gui--valid-simple-selection-p (aref data i)) (or (gui--valid-simple-selection-p (aref data i))
(setq valid nil)) (setq valid nil)))
(setq i (1- i)))
valid)) valid))
(signal 'error (list "invalid selection" data))) (signal 'error (list "invalid selection" data)))
(or type (setq type 'PRIMARY)) (or type (setq type 'PRIMARY))
(if data (gui-call gui-set-selection type data)
(gui-call gui-own-selection type data)
(gui-call gui-disown-selection type))
data) data)
(define-obsolete-function-alias 'x-set-selection 'gui-set-selection "25.1") (define-obsolete-function-alias 'x-set-selection 'gui-set-selection "25.1")
@ -295,13 +361,13 @@ are not available to other programs."
(markerp (car data)) (markerp (car data))
(markerp (cdr data)) (markerp (cdr data))
(marker-buffer (car data)) (marker-buffer (car data))
(buffer-name (marker-buffer (car data))) (buffer-live-p (marker-buffer (car data)))
(eq (marker-buffer (car data)) (eq (marker-buffer (car data))
(marker-buffer (cdr data)))) (marker-buffer (cdr data))))
(stringp data) (stringp data)
(and (overlayp data) (and (overlayp data)
(overlay-buffer data) (overlay-buffer data)
(buffer-name (overlay-buffer data))) (buffer-live-p (overlay-buffer data)))
(symbolp data) (symbolp data)
(integerp data))) (integerp data)))
@ -445,7 +511,7 @@ two markers or an overlay. Otherwise, it is nil."
(apply 'vector all))) (apply 'vector all)))
(defun xselect-convert-to-delete (selection _type _value) (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, ;; 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 ;; 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. ;; done the conversion (and any side-effects) but have no value to return.

3
lisp/simple.el
View File

@ -5363,7 +5363,8 @@ If NOERROR, don't signal an error if we can't move that many lines."
((car (posn-x-y posn)) ((car (posn-x-y posn))
(setq temporary-goal-column (setq temporary-goal-column
(cons (/ (float (car (posn-x-y posn))) (cons (/ (float (car (posn-x-y posn)))
(frame-char-width)) hscroll)))))) (frame-char-width))
hscroll))))))
(if target-hscroll (if target-hscroll
(set-window-hscroll (selected-window) target-hscroll)) (set-window-hscroll (selected-window) target-hscroll))
;; vertical-motion can move more than it was asked to if it moves ;; vertical-motion can move more than it was asked to if it moves

4
lisp/startup.el
View File

@ -950,11 +950,11 @@ please check its value")
;; Process window-system specific command line parameters. ;; Process window-system specific command line parameters.
(setq command-line-args (setq command-line-args
(funcall (funcall
(gui-method handle-args-function (or initial-window-system t)) (gui-method handle-args-function initial-window-system)
command-line-args)) command-line-args))
;; Initialize the window system. (Open connection, etc.) ;; Initialize the window system. (Open connection, etc.)
(funcall (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)) (put initial-window-system 'window-system-initialized t))
;; If there was an error, print the error message and exit. ;; If there was an error, print the error message and exit.
(error (error

37
lisp/term/ns-win.el
View File

@ -726,25 +726,6 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
'ns-store-selection-internal "24.1") '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 () (defun ns-copy-including-secondary ()
(interactive) (interactive)
(call-interactively 'kill-ring-save) (call-interactively 'kill-ring-save)
@ -950,19 +931,13 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(gui-method-define window-system-initialization ns (gui-method-define window-system-initialization ns
#'ns-initialize-window-system) #'ns-initialize-window-system)
(declare-function ns-set-pasteboard "ns-win" (string)) (gui-method-define gui-set-selection ns
(gui-method-define gui-select-text ns (lambda (selection value)
(lambda (text) (if value (ns-own-selection-internal selection value)
;; Don't send the pasteboard too much text. (ns-disown-selection-internal selection))))
;; 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-selection-owner-p ns #'ns-selection-owner-p) (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-selection-exists-p ns #'ns-selection-exists-p)
(gui-method-define gui-get-selection ns #'x-get-selection-internal) ;FIXME:name! (gui-method-define gui-get-selection ns #'ns-get-selection)
(provide 'ns-win) (provide 'ns-win)

48
lisp/term/pc-win.el
View File

@ -219,16 +219,15 @@ the operating system.")
; ;
;;;; Selections ;;;; Selections
; ;
(defun w16-get-selection-value () (defun w16-get-selection-value (_selection-symbol _target-type)
"Return the value of the current selection. "Return the value of the current selection.
Consult the selection. Treat empty strings as if they were unset." 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.
;; Don't die if x-get-selection signals an error. (with-demoted-errors "w16-get-clipboard-data:%s"
(with-demoted-errors "w16-get-clipboard-data:%s" (w16-get-clipboard-data)))
(w16-get-clipboard-data))))
;; gui-selection-owner-p is used in simple.el. ;; 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) (gui-method-define gui-selection-owner-p pc #'w16-selection-owner-p)
(defun w16-selection-owner-p (_selection) (defun w16-selection-owner-p (_selection)
;; FIXME: Other systems don't obey gui-select-enable-clipboard here. ;; FIXME: Other systems don't obey gui-select-enable-clipboard here.
@ -248,24 +247,22 @@ Consult the selection. Treat empty strings as if they were unset."
text) text)
(t nil))))) (t nil)))))
;; gui-own-selection and gui-disown-selection are used in gui-set-selection. ;; gui-set-selection is used in gui-set-selection.
(gui-method-define gui-own-selection pc (declare-function w16-set-clipboard-data "w16select.c"
(lambda (_selection value) (string &optional ignored))
;; FIXME: Other systems don't obey (gui-method-define gui-set-selection pc
;; gui-select-enable-clipboard here. (lambda (selection value)
(ignore-errors (if (not value)
(w16--select-text value)) (if (w16-selection-owner-p selection)
value)) t)
;; FIXME: Other systems don't obey
(gui-method-define gui-disown-selection pc ;; gui-select-enable-clipboard here.
(lambda (selection &optional _time-object _terminal) (with-demoted-errors "w16-set-clipboard-data: %S"
(if (w16-selection-owner-p selection) (w16-set-clipboard-data value))
t))) value)))
;; gui-get-selection is used in select.el ;; gui-get-selection is used in select.el
(gui-method-define gui-get-selection pc (gui-method-define gui-get-selection pc #'w16-get-selection-value)
(lambda (selection-symbol target-type)
(w16-get-selection-value)))
;; From src/fontset.c: ;; From src/fontset.c:
(fset 'query-fontset 'ignore) (fset 'query-fontset 'ignore)
@ -384,13 +381,6 @@ Errors out because it is not supposed to be called, ever."
(gui-method-define handle-args-function pc #'tty-handle-args) (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)))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------

56
lisp/term/w32-win.el
View File

@ -382,45 +382,35 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(string &optional ignored)) (string &optional ignored))
(declare-function w32-get-clipboard-data "w32select.c") (declare-function w32-get-clipboard-data "w32select.c")
(defun w32--select-text (text) ;;; Fix interface to (X-specific) mouse.el
(if gui-select-enable-clipboard (w32-set-clipboard-data text))) (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-value () (defun w32--get-selection (&optional type data-type)
"Return the value of the current selection. (if (and (eq type 'CLIPBOARD)
Consult the selection. Treat empty strings as if they were unset." (eq data-type 'STRING))
(if gui-select-enable-clipboard
;; Don't die if x-get-selection signals an error.
(with-demoted-errors "w32-get-clipboard-data:%S" (with-demoted-errors "w32-get-clipboard-data:%S"
(w32-get-clipboard-data)))) (w32-get-clipboard-data))
(get 'x-selections (or type 'PRIMARY))))
;; Arrange for the kill and yank functions to set and check the clipboard. (defun w32--selection-owner-p (selection)
(gui-method-define gui-select-text w32 #'w32--select-text) (and (memq selection '(nil PRIMARY SECONDARY))
(gui-method-define gui-selection-value w32 #'w32--get-selection-value) (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)
(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) (when (eq system-type 'windows-nt)
;; Make copy&pasting in w32's console interact with the system's clipboard! ;; 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-set-selection nil #'w32--set-selection)
(gui-method-define gui-selection-value t #'w32--get-selection-value)) (gui-method-define gui-get-selection nil #'w32--get-selection)
(gui-method-define gui-selection-owner-p nil #'w32--selection-owner-p)
;;; Fix interface to (X-specific) mouse.el (gui-method-define gui-selection-exists-p nil #'w32-selection-exists-p))
(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)
;; The "Windows" keys on newer keyboards bring up the Start menu ;; The "Windows" keys on newer keyboards bring up the Start menu
;; whether you want it or not - make Emacs ignore these keystrokes ;; whether you want it or not - make Emacs ignore these keystrokes

149
lisp/term/x-win.el
View File

@ -1154,136 +1154,6 @@ as returned by `x-server-vendor'."
;;;; Selections ;;;; 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 (define-obsolete-function-alias 'x-cut-buffer-or-selection-value
'x-selection-value "24.1") 'x-selection-value "24.1")
@ -1457,21 +1327,10 @@ This returns an error if any Emacs frames are X frames."
(gui-method-define frame-creation-function x #'x-create-frame-with-faces) (gui-method-define frame-creation-function x #'x-create-frame-with-faces)
(gui-method-define window-system-initialization x #'x-initialize-window-system) (gui-method-define window-system-initialization x #'x-initialize-window-system)
(defvar x-select-enable-primary) ; x-win.el (gui-method-define gui-set-selection x
(gui-method-define gui-select-text x (lambda (selection value)
(lambda (text) (if value (x-own-selection-internal selection value)
(when x-select-enable-primary (x-disown-selection-internal selection))))
(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-selection-owner-p x #'x-selection-owner-p) (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-selection-exists-p x #'x-selection-exists-p)
(gui-method-define gui-get-selection x #'x-get-selection-internal) (gui-method-define gui-get-selection x #'x-get-selection-internal)

18
src/ChangeLog
View File

@ -1,3 +1,21 @@
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> 2014-10-21 Martin Rudalics <rudalics@gmx.at>
* w32fns.c (Fw32_frame_menu_bar_size): New function. * w32fns.c (Fw32_frame_menu_bar_size): New function.

77
src/nsselect.m
View File

@ -26,7 +26,7 @@ Updated by Christian Limpach (chris@nice.ch)
*/ */
/* This should be the first include, as it may set up #defines affecting /* 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 <config.h>
#include "lisp.h" #include "lisp.h"
@ -161,8 +161,10 @@ Updated by Christian Limpach (chris@nice.ch)
length: SBYTES (str) length: SBYTES (str)
encoding: NSUTF8StringEncoding encoding: NSUTF8StringEncoding
freeWhenDone: NO]; freeWhenDone: NO];
// FIXME: Why those 2 different code paths?
if (gtype == nil) if (gtype == nil)
{ {
// Used for ns-store-selection-internal.
[pb declareTypes: ns_send_types owner: nil]; [pb declareTypes: ns_send_types owner: nil];
tenum = [ns_send_types objectEnumerator]; tenum = [ns_send_types objectEnumerator];
while ( (type = [tenum nextObject]) ) while ( (type = [tenum nextObject]) )
@ -170,6 +172,8 @@ Updated by Christian Limpach (chris@nice.ch)
} }
else else
{ {
// Used for ns-own-selection-internal.
eassert (type == NSStringPboardType);
[pb setString: nsStr forType: gtype]; [pb setString: nsStr forType: gtype];
} }
[nsStr release]; [nsStr release];
@ -183,13 +187,12 @@ Updated by Christian Limpach (chris@nice.ch)
{ {
Lisp_Object local_value; Lisp_Object local_value;
Lisp_Object handler_fn, value, check; Lisp_Object handler_fn, value, check;
ptrdiff_t count; ptrdiff_t count = specpdl_ptr - specpdl;
local_value = assq_no_quit (selection_name, Vselection_alist); local_value = assq_no_quit (selection_name, Vselection_alist);
if (NILP (local_value)) return Qnil; if (NILP (local_value)) return Qnil;
count = specpdl_ptr - specpdl;
specbind (Qinhibit_quit, Qt); specbind (Qinhibit_quit, Qt);
CHECK_SYMBOL (target_type); CHECK_SYMBOL (target_type);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
@ -212,19 +215,16 @@ Updated by Christian Limpach (chris@nice.ch)
if (CONSP (check) if (CONSP (check)
&& INTEGERP (XCAR (check)) && INTEGERP (XCAR (check))
&& (INTEGERP (XCDR (check))|| && (INTEGERP (XCDR (check))
(CONSP (XCDR (check)) || (CONSP (XCDR (check))
&& INTEGERP (XCAR (XCDR (check))) && INTEGERP (XCAR (XCDR (check)))
&& NILP (XCDR (XCDR (check)))))) && NILP (XCDR (XCDR (check))))))
return value; return value;
// FIXME: Why `quit' rather than `error'? Fsignal (Qerror,
Fsignal (Qquit,
list3 (build_string ("invalid data returned by" list3 (build_string ("invalid data returned by"
" selection-conversion function"), " selection-conversion function"),
handler_fn, value)); handler_fn, value));
// FIXME: Beware, `quit' can return!!
return Qnil;
} }
@ -338,7 +338,6 @@ Updated by Christian Limpach (chris@nice.ch)
(Lisp_Object selection, Lisp_Object value) (Lisp_Object selection, Lisp_Object value)
{ {
id pb; id pb;
Lisp_Object old_value, new_value;
NSString *type; NSString *type;
Lisp_Object successful_p = Qnil, rest; Lisp_Object successful_p = Qnil, rest;
Lisp_Object target_symbol, data; Lisp_Object target_symbol, data;
@ -351,13 +350,15 @@ Updated by Christian Limpach (chris@nice.ch)
if (pb == nil) return Qnil; if (pb == nil) return Qnil;
ns_declare_pasteboard (pb); 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)) if (NILP (old_value))
Vselection_alist = Fcons (new_value, Vselection_alist); Vselection_alist = Fcons (new_value, Vselection_alist);
else else
Fsetcdr (old_value, Fcdr (new_value)); Fsetcdr (old_value, Fcdr (new_value));
}
/* We only support copy of text. */ /* We only support copy of text. */
type = NSStringPboardType; type = NSStringPboardType;
@ -372,6 +373,7 @@ Updated by Christian Limpach (chris@nice.ch)
if (!EQ (Vns_sent_selection_hooks, Qunbound)) if (!EQ (Vns_sent_selection_hooks, Qunbound))
{ {
/* FIXME: Use run-hook-with-args! */
for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest)) for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
call3 (Fcar (rest), selection, target_symbol, successful_p); call3 (Fcar (rest), selection, target_symbol, successful_p);
} }
@ -397,7 +399,7 @@ Updated by Christian Limpach (chris@nice.ch)
} }
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. 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 SELECTION should be the name of the selection in question, typically
one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
@ -452,8 +454,8 @@ Updated by Christian Limpach (chris@nice.ch)
} }
DEFUN ("x-get-selection-internal", Fx_get_selection_internal, DEFUN ("ns-get-selection", Fns_get_selection,
Sx_get_selection_internal, 2, 4, 0, Sns_get_selection, 2, 4, 0,
doc: /* Return text selected from some X window. doc: /* Return text selected from some X window.
SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. SELECTION-SYMBOL is typically `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.)
@ -489,33 +491,6 @@ Updated by Christian Limpach (chris@nice.ch)
} }
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 void
nxatoms_of_nsselect (void) nxatoms_of_nsselect (void)
{ {
@ -532,12 +507,10 @@ Updated by Christian Limpach (chris@nice.ch)
QFILE_NAME = intern_c_string ("FILE_NAME"); staticpro (&QFILE_NAME); QFILE_NAME = intern_c_string ("FILE_NAME"); staticpro (&QFILE_NAME);
defsubr (&Sns_disown_selection_internal); defsubr (&Sns_disown_selection_internal);
defsubr (&Sx_get_selection_internal); defsubr (&Sns_get_selection);
defsubr (&Sns_own_selection_internal); defsubr (&Sns_own_selection_internal);
defsubr (&Sx_selection_exists_p); defsubr (&Sns_selection_exists_p);
defsubr (&Sns_selection_owner_p); defsubr (&Sns_selection_owner_p);
defsubr (&Sns_get_selection_internal);
defsubr (&Sns_store_selection_internal);
Vselection_alist = Qnil; Vselection_alist = Qnil;
staticpro (&Vselection_alist); staticpro (&Vselection_alist);

6
src/w16select.c
View File

@ -625,9 +625,9 @@ DEFUN ("w16-get-clipboard-data", Fw16_get_clipboard_data, Sw16_get_clipboard_dat
return (ret); 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, 0, 2, 0,
doc: /* Whether there is an owner for the given X selection. doc: /* Whether there is an owner for the given X selection.
SELECTION should be the name of the selection in question, typically SELECTION should be the name of the selection in question, typically
@ -677,7 +677,7 @@ syms_of_win16select (void)
{ {
defsubr (&Sw16_set_clipboard_data); defsubr (&Sw16_set_clipboard_data);
defsubr (&Sw16_get_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, DEFVAR_LISP ("selection-coding-system", Vselection_coding_system,
doc: /* Coding system for communicating with other programs. doc: /* Coding system for communicating with other programs.

10
src/w32select.c
View File

@ -1013,9 +1013,9 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data,
return (ret); 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, 0, 2, 0,
doc: /* Whether there is an owner for the given X selection. doc: /* Whether there is an owner for the given X selection.
SELECTION should be the name of the selection in question, typically SELECTION should be the name of the selection in question, typically
@ -1031,7 +1031,7 @@ frame's display, or the first available X display. */)
CHECK_SYMBOL (selection); CHECK_SYMBOL (selection);
/* Return nil for PRIMARY and SECONDARY selections; for CLIPBOARD, check /* 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)) if (EQ (selection, QCLIPBOARD))
{ {
@ -1060,14 +1060,14 @@ frame's display, or the first available X display. */)
} }
/* One-time init. Called in the un-dumped Emacs, but not in the /* One-time init. Called in the un-dumped Emacs, but not in the
dumped version. */ dumped version. */
void void
syms_of_w32select (void) syms_of_w32select (void)
{ {
defsubr (&Sw32_set_clipboard_data); defsubr (&Sw32_set_clipboard_data);
defsubr (&Sw32_get_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, DEFVAR_LISP ("selection-coding-system", Vselection_coding_system,
doc: /* Coding system for communicating with other programs. doc: /* Coding system for communicating with other programs.