aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-10-01 18:13:11 -0400
committerStefan Monnier2014-10-01 18:13:11 -0400
commita8b36b953e3dc4d50dbfe430d5c579f7b1fd71e7 (patch)
treecfbea5b3f0c9514911375ef68a290c193730bf22
parentc59ef5ef53f8e33a693f1107c1d61535bbd3a187 (diff)
downloademacs-a8b36b953e3dc4d50dbfe430d5c579f7b1fd71e7.tar.gz
emacs-a8b36b953e3dc4d50dbfe430d5c579f7b1fd71e7.zip
Consolidate x-select-text.
* lisp/frame.el (gui-method, gui-method-define, gui-method-declare) (gui-call): New macros. (gui-method--name): New function. (frame-creation-function-alist): Use gui-method-declare. (make-frame): Use gui-method. * lisp/select.el (gui-select-enable-clipboard): Rename from x-select-enable-clipboard and move here. (x-select-enable-clipboard): Define as obsolete alias. (gui-last-selected-text): New var, to replace x-last-selected-text. (gui-select-text): New GUI method. (gui-select-text): New function. (x-select-text): Define as obsolete alias. * lisp/term/common-win.el (x-select-enable-clipboard, x-select-text): Move to select.el. * lisp/simple.el (interprogram-cut-function): Change default to x-select-text. (interprogram-paste-function): Change default to `ignore'. * lisp/w32-common-fns.el (interprogram-cut-function): Don't modify. * lisp/term/x-win.el (interprogram-cut-function): Don't modify. (gui-select-text): Add method for x. * lisp/term/w32-win.el (gui-select-text): Add method for w32. * lisp/term/pc-win.el (x-last-selected-text): Remove, use gui-last-selected-text instead. (msdos-initialize-window-system): Don't set interprogram-cut-function. (gui-select-text): Add method for pc. * lisp/term/ns-win.el (ns-last-selected-text): Remove, use gui-last-selected-text instead. (gui-select-text): Add method for ns. (x-setup-function-keys): Don't change interprogram-cut-function. * lisp/loadup.el ("startup"): Load after "frame". * lisp/subr.el (package--builtin-versions, package--description-file): Move from startup.el. * lisp/startup.el (package--builtin-versions, package--description-file): Move to subr.el. (handle-args-function-alist, window-system-initialization-alist): Use gui-method-declare. (command-line): Use gui-method. * src/xselect.c (selection-converter-alist): Fix docstring.
-rw-r--r--etc/NEWS7
-rw-r--r--lisp/emacs-lisp/cl-lib.el1
-rw-r--r--lisp/eshell/esh-io.el6
-rw-r--r--lisp/frame.el49
-rw-r--r--lisp/loadup.el2
-rw-r--r--lisp/menu-bar.el10
-rw-r--r--lisp/select.el35
-rw-r--r--lisp/simple.el4
-rw-r--r--lisp/startup.el39
-rw-r--r--lisp/subr.el15
-rw-r--r--lisp/term/common-win.el64
-rw-r--r--lisp/term/ns-win.el25
-rw-r--r--lisp/term/pc-win.el69
-rw-r--r--lisp/term/w32-win.el15
-rw-r--r--lisp/term/x-win.el24
-rw-r--r--lisp/w32-common-fns.el4
-rw-r--r--src/xselect.c4
17 files changed, 182 insertions, 191 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 8c2b64b14fc..ddcd70cb11a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -49,6 +49,9 @@ Use './configure PKG_CONFIG=/full/name/of/pkg-config' if you need to.
49 49
50* Changes in Emacs 25.1 50* Changes in Emacs 25.1
51 51
52** x-select-enable-clipboard is renamed gui-select-enable-clipboard.
53Additionally it now also applies to OSX and GNUstep.
54
52** `insert-register' now leaves point after the inserted text 55** `insert-register' now leaves point after the inserted text
53when called interactively. A prefix argument toggles this behavior. 56when called interactively. A prefix argument toggles this behavior.
54 57
@@ -242,7 +245,9 @@ Emacs-21.
242 245
243* Lisp Changes in Emacs 25.1 246* Lisp Changes in Emacs 25.1
244 247
245*** call-process-shell-command and process-file-shell-command 248** x-select-text is renamed gui-select-text.
249
250** call-process-shell-command and process-file-shell-command
246don't take "&rest args" any more. 251don't take "&rest args" any more.
247 252
248** New function `alist-get', which is also a valid place (aka lvalue). 253** New function `alist-get', which is also a valid place (aka lvalue).
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 09cc3eee985..c7d21c76fc1 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -701,7 +701,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
701(gv-define-setter window-width (store) 701(gv-define-setter window-width (store)
702 `(progn (enlarge-window (- ,store (window-width)) t) ,store)) 702 `(progn (enlarge-window (- ,store (window-width)) t) ,store))
703(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t) 703(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
704(gv-define-simple-setter x-get-selection x-own-selection t)
705 704
706;; More complex setf-methods. 705;; More complex setf-methods.
707 706
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index b7830db08b5..ebbca58a442 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -118,8 +118,6 @@ from executing while Emacs is redisplaying."
118 :type 'integer 118 :type 'integer
119 :group 'eshell-io) 119 :group 'eshell-io)
120 120
121(defvar x-select-enable-clipboard) ; term/common-win
122
123(defcustom eshell-virtual-targets 121(defcustom eshell-virtual-targets
124 '(("/dev/eshell" eshell-interactive-print nil) 122 '(("/dev/eshell" eshell-interactive-print nil)
125 ("/dev/kill" (lambda (mode) 123 ("/dev/kill" (lambda (mode)
@@ -128,7 +126,7 @@ from executing while Emacs is redisplaying."
128 'eshell-kill-append) t) 126 'eshell-kill-append) t)
129 ("/dev/clip" (lambda (mode) 127 ("/dev/clip" (lambda (mode)
130 (if (eq mode 'overwrite) 128 (if (eq mode 'overwrite)
131 (let ((x-select-enable-clipboard t)) 129 (let ((gui-select-enable-clipboard t))
132 (kill-new ""))) 130 (kill-new "")))
133 'eshell-clipboard-append) t)) 131 'eshell-clipboard-append) t))
134 "Map virtual devices name to Emacs Lisp functions. 132 "Map virtual devices name to Emacs Lisp functions.
@@ -328,7 +326,7 @@ last execution result should not be changed."
328(defun eshell-clipboard-append (string) 326(defun eshell-clipboard-append (string)
329 "Call `kill-append' with STRING, if it is indeed a string." 327 "Call `kill-append' with STRING, if it is indeed a string."
330 (if (stringp string) 328 (if (stringp string)
331 (let ((x-select-enable-clipboard t)) 329 (let ((gui-select-enable-clipboard t))
332 (kill-append string nil)))) 330 (kill-append string nil))))
333 331
334(defun eshell-get-target (target &optional mode) 332(defun eshell-get-target (target &optional mode)
diff --git a/lisp/frame.el b/lisp/frame.el
index f144cf23405..18aff5b2879 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -26,21 +26,39 @@
26;;; Code: 26;;; Code:
27(eval-when-compile (require 'cl-lib)) 27(eval-when-compile (require 'cl-lib))
28 28
29(defvar frame-creation-function-alist 29;; Dispatch tables for GUI methods.
30 (list (cons nil 30
31 (if (fboundp 'tty-create-frame-with-faces) 31(defun gui-method--name (base)
32 'tty-create-frame-with-faces 32 (intern (format "%s-alist" base)))
33 (lambda (_parameters) 33
34 (error "Can't create multiple frames without a window system"))))) 34(defmacro gui-method (name &optional type)
35 "Alist of window-system dependent functions to call to create a new frame. 35 (macroexp-let2 nil type (or type `(framep (selected-frame)))
36 `(alist-get ,type ,(gui-method--name name)
37 (lambda (&rest _args)
38 (error "No method %S for %S frame" ',name ,type)))))
39
40(defmacro gui-method-define (name type fun)
41 `(setf (gui-method ,name ',type) ,fun))
42
43(defmacro gui-method-declare (name &optional tty-fun doc)
44 (declare (doc-string 3) (indent 2))
45 `(defvar ,(gui-method--name name)
46 ,(if tty-fun `(list (cons t ,tty-fun))) ,doc))
47
48(defmacro gui-call (name &rest args)
49 `(funcall (gui-method ,name) ,@args))
50
51(gui-method-declare frame-creation-function
52 #'tty-create-frame-with-faces
53 "Method for window-system dependent functions to create a new frame.
36The window system startup file should add its frame creation 54The window system startup file should add its frame creation
37function to this list, which should take an alist of parameters 55function to this method, which should take an alist of parameters
38as its argument.") 56as its argument.")
39 57
40(defvar window-system-default-frame-alist nil 58(defvar window-system-default-frame-alist nil
41 "Window-system dependent default frame parameters. 59 "Window-system dependent default frame parameters.
42The value should be an alist of elements (WINDOW-SYSTEM . ALIST), 60The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
43where WINDOW-SYSTEM is a window system symbol (see `window-system') 61where WINDOW-SYSTEM is a window system symbol (as returned by `framep')
44and ALIST is a frame parameter alist like `default-frame-alist'. 62and ALIST is a frame parameter alist like `default-frame-alist'.
45Then, for frames on WINDOW-SYSTEM, any parameters specified in 63Then, for frames on WINDOW-SYSTEM, any parameters specified in
46ALIST supersede the corresponding parameters specified in 64ALIST supersede the corresponding parameters specified in
@@ -632,9 +650,8 @@ the new frame according to its own rules."
632 ((assq 'terminal parameters) 650 ((assq 'terminal parameters)
633 (let ((type (terminal-live-p (cdr (assq 'terminal parameters))))) 651 (let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
634 (cond 652 (cond
635 ((eq type t) nil) 653 ((null type) (error "Terminal %s does not exist"
636 ((eq type nil) (error "Terminal %s does not exist" 654 (cdr (assq 'terminal parameters))))
637 (cdr (assq 'terminal parameters))))
638 (t type)))) 655 (t type))))
639 ((assq 'window-system parameters) 656 ((assq 'window-system parameters)
640 (cdr (assq 'window-system parameters))) 657 (cdr (assq 'window-system parameters)))
@@ -643,15 +660,12 @@ the new frame according to its own rules."
643 (error "Don't know how to interpret display %S" 660 (error "Don't know how to interpret display %S"
644 display))) 661 display)))
645 (t window-system))) 662 (t window-system)))
646 (frame-creation-function (cdr (assq w frame-creation-function-alist)))
647 (oldframe (selected-frame)) 663 (oldframe (selected-frame))
648 (params parameters) 664 (params parameters)
649 frame) 665 frame)
650 (unless frame-creation-function
651 (error "Don't know how to create a frame on window system %s" w))
652 666
653 (unless (get w 'window-system-initialized) 667 (unless (get w 'window-system-initialized)
654 (funcall (cdr (assq w window-system-initialization-alist)) display) 668 (funcall (gui-method window-system-initialization w) display)
655 (setq x-display-name display) 669 (setq x-display-name display)
656 (put w 'window-system-initialized t)) 670 (put w 'window-system-initialized t))
657 671
@@ -665,7 +679,8 @@ the new frame according to its own rules."
665 (push p params))) 679 (push p params)))
666 ;; Now make the frame. 680 ;; Now make the frame.
667 (run-hooks 'before-make-frame-hook) 681 (run-hooks 'before-make-frame-hook)
668 (setq frame (funcall frame-creation-function params)) 682 (setq frame
683 (funcall (gui-method frame-creation-function w) params))
669 (normal-erase-is-backspace-setup-frame frame) 684 (normal-erase-is-backspace-setup-frame frame)
670 ;; Inherit the original frame's parameters. 685 ;; Inherit the original frame's parameters.
671 (dolist (param frame-inherited-parameters) 686 (dolist (param frame-inherited-parameters)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index c1206e243c5..9c052b284b8 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -126,7 +126,6 @@
126(load "faces") ; after here, `defface' may be used. 126(load "faces") ; after here, `defface' may be used.
127 127
128(load "button") 128(load "button")
129(load "startup")
130 129
131;; We don't want to store loaddefs.el in the repository because it is 130;; We don't want to store loaddefs.el in the repository because it is
132;; a generated file; but it is required in order to compile the lisp files. 131;; a generated file; but it is required in order to compile the lisp files.
@@ -193,6 +192,7 @@
193 192
194(load "indent") 193(load "indent")
195(load "frame") 194(load "frame")
195(load "startup")
196(load "term/tty-colors") 196(load "term/tty-colors")
197(load "font-core") 197(load "font-core")
198;; facemenu must be loaded before font-lock, because `facemenu-keymap' 198;; facemenu must be loaded before font-lock, because `facemenu-keymap'
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 9657c5924f9..35f996c5750 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -545,19 +545,19 @@
545(defun clipboard-yank () 545(defun clipboard-yank ()
546 "Insert the clipboard contents, or the last stretch of killed text." 546 "Insert the clipboard contents, or the last stretch of killed text."
547 (interactive "*") 547 (interactive "*")
548 (let ((x-select-enable-clipboard t)) 548 (let ((gui-select-enable-clipboard t))
549 (yank))) 549 (yank)))
550 550
551(defun clipboard-kill-ring-save (beg end &optional region) 551(defun clipboard-kill-ring-save (beg end &optional region)
552 "Copy region to kill ring, and save in the X clipboard." 552 "Copy region to kill ring, and save in the GUI's clipboard."
553 (interactive "r\np") 553 (interactive "r\np")
554 (let ((x-select-enable-clipboard t)) 554 (let ((gui-select-enable-clipboard t))
555 (kill-ring-save beg end region))) 555 (kill-ring-save beg end region)))
556 556
557(defun clipboard-kill-region (beg end &optional region) 557(defun clipboard-kill-region (beg end &optional region)
558 "Kill the region, and save it in the X clipboard." 558 "Kill the region, and save it in the GUI's clipboard."
559 (interactive "r\np") 559 (interactive "r\np")
560 (let ((x-select-enable-clipboard t)) 560 (let ((gui-select-enable-clipboard t))
561 (kill-region beg end region))) 561 (kill-region beg end region)))
562 562
563(defun menu-bar-enable-clipboard () 563(defun menu-bar-enable-clipboard ()
diff --git a/lisp/select.el b/lisp/select.el
index c4d020343af..c32b45f1c85 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -77,6 +77,41 @@ After the communication, this variable is set to nil.")
77;; Only declared obsolete in 23.3. 77;; Only declared obsolete in 23.3.
78(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34") 78(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34")
79 79
80(defcustom gui-select-enable-clipboard t
81 "Non-nil means cutting and pasting uses the clipboard.
82This can be in addition to, but in preference to, the primary selection,
83if applicable (i.e. under X11)."
84 :type 'boolean
85 :group 'killing
86 ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not.
87 :version "24.1")
88(define-obsolete-variable-alias 'x-select-enable-clipboard
89 'gui-select-enable-clipboard "25.1")
90
91(gui-method-declare gui-select-text #'ignore
92 "Method used to pass the current selection to the system.
93Called with one argument (the text selected).
94Should obey `gui-select-enable-clipboard' where applicable.")
95
96(defvar gui-last-selected-text nil
97 "Last text passed to `gui-select-text'.")
98
99(defun gui-select-text (text)
100 "Select TEXT, a string, according to the window system.
101if `gui-select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard.
102
103On X, if `x-select-enable-primary' is non-nil, put TEXT in
104the primary selection.
105
106On MS-Windows, make TEXT the current selection."
107 ;; FIXME: We should test gui-select-enable-clipboard here!
108 ;; But that would break the independence between x-select-enable-primary
109 ;; and x-select-enable-clipboard!
110 ;;(when gui-select-enable-clipboard
111 (gui-call gui-select-text text) ;;)
112 (setq gui-last-selected-text text))
113(define-obsolete-function-alias 'x-select-text 'gui-select-text "25.1")
114
80(defun x-get-selection (&optional type data-type) 115(defun x-get-selection (&optional type data-type)
81 "Return the value of an X Windows selection. 116 "Return the value of an X Windows selection.
82The argument TYPE (default `PRIMARY') says which selection, 117The argument TYPE (default `PRIMARY') says which selection,
diff --git a/lisp/simple.el b/lisp/simple.el
index 8469ff0d892..8504cf4be19 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3629,7 +3629,7 @@ No filtering is done unless a hook says to."
3629 3629
3630;;;; Window system cut and paste hooks. 3630;;;; Window system cut and paste hooks.
3631 3631
3632(defvar interprogram-cut-function nil 3632(defvar interprogram-cut-function #'x-select-text
3633 "Function to call to make a killed region available to other programs. 3633 "Function to call to make a killed region available to other programs.
3634Most window systems provide a facility for cutting and pasting 3634Most window systems provide a facility for cutting and pasting
3635text between different programs, such as the clipboard on X and 3635text between different programs, such as the clipboard on X and
@@ -3640,7 +3640,7 @@ put in the kill ring, to make the new kill available to other
3640programs. The function takes one argument, TEXT, which is a 3640programs. The function takes one argument, TEXT, which is a
3641string containing the text which should be made available.") 3641string containing the text which should be made available.")
3642 3642
3643(defvar interprogram-paste-function nil 3643(defvar interprogram-paste-function #'ignore
3644 "Function to call to get text cut from other programs. 3644 "Function to call to get text cut from other programs.
3645Most window systems provide a facility for cutting and pasting 3645Most window systems provide a facility for cutting and pasting
3646text between different programs, such as the clipboard on X and 3646text between different programs, such as the clipboard on X and
diff --git a/lisp/startup.el b/lisp/startup.el
index c46200a050d..a0bcd1fcaba 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -421,21 +421,6 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
421 :type 'directory 421 :type 'directory
422 :initialize 'custom-initialize-delay) 422 :initialize 'custom-initialize-delay)
423 423
424(defvar package--builtin-versions
425 ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
426 (purecopy `((emacs . ,(version-to-list emacs-version))))
427 "Alist giving the version of each versioned builtin package.
428I.e. each element of the list is of the form (NAME . VERSION) where
429NAME is the package name as a symbol, and VERSION is its version
430as a list.")
431
432(defun package--description-file (dir)
433 (concat (let ((subdir (file-name-nondirectory
434 (directory-file-name dir))))
435 (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
436 (match-string 1 subdir) subdir))
437 "-pkg.el"))
438
439(defun normal-top-level-add-subdirs-to-load-path () 424(defun normal-top-level-add-subdirs-to-load-path ()
440 "Add all subdirectories of `default-directory' to `load-path'. 425 "Add all subdirectories of `default-directory' to `load-path'.
441More precisely, this uses only the subdirectories whose names 426More precisely, this uses only the subdirectories whose names
@@ -719,17 +704,17 @@ It is the default value of the variable `top-level'."
719(defconst tool-bar-images-pixel-height 24 704(defconst tool-bar-images-pixel-height 24
720 "Height in pixels of images in the tool-bar.") 705 "Height in pixels of images in the tool-bar.")
721 706
722(defvar handle-args-function-alist '((nil . tty-handle-args)) 707(gui-method-declare handle-args-function #'tty-handle-args
723 "Functions for processing window-system dependent command-line arguments. 708 "Method for processing window-system dependent command-line arguments.
724Window system startup files should add their own function to this 709Window system startup files should add their own function to this
725alist, which should parse the command line arguments. Those 710method, which should parse the command line arguments. Those
726pertaining to the window system should be processed and removed 711pertaining to the window system should be processed and removed
727from the returned command line.") 712from the returned command line.")
728 713
729(defvar window-system-initialization-alist '((nil . ignore)) 714(gui-method-declare window-system-initialization #'ignore
730 "Alist of window-system initialization functions. 715 "Method for window-system initialization.
731Window-system startup files should add their own initialization 716Window-system startup files should add their own implementation
732function to this list. The function should take no arguments, 717to this method. The function should take no arguments,
733and initialize the window system environment to prepare for 718and initialize the window system environment to prepare for
734opening the first frame (e.g. open a connection to an X server).") 719opening the first frame (e.g. open a connection to an X server).")
735 720
@@ -965,8 +950,7 @@ please check its value")
965 ;; Process window-system specific command line parameters. 950 ;; Process window-system specific command line parameters.
966 (setq command-line-args 951 (setq command-line-args
967 (funcall 952 (funcall
968 (or (cdr (assq initial-window-system handle-args-function-alist)) 953 (gui-method handle-args-function (or initial-window-system t))
969 (error "Unsupported window system `%s'" initial-window-system))
970 command-line-args)) 954 command-line-args))
971 ;; Initialize the window system. (Open connection, etc.) 955 ;; Initialize the window system. (Open connection, etc.)
972 (funcall 956 (funcall
@@ -1311,9 +1295,10 @@ the `--debug-init' option to view a complete error backtrace."
1311 (format "Your `load-path' seems to contain 1295 (format "Your `load-path' seems to contain
1312your `.emacs.d' directory: %s\n\ 1296your `.emacs.d' directory: %s\n\
1313This is likely to cause problems...\n\ 1297This is likely to cause problems...\n\
1314Consider using a subdirectory instead, e.g.: %s" dir 1298Consider using a subdirectory instead, e.g.: %s"
1315(expand-file-name "lisp" user-emacs-directory)) 1299 dir (expand-file-name
1316 :warning)))) 1300 "lisp" user-emacs-directory))
1301 :warning))))
1317 1302
1318 ;; If -batch, terminate after processing the command options. 1303 ;; If -batch, terminate after processing the command options.
1319 (if noninteractive (kill-emacs t)) 1304 (if noninteractive (kill-emacs t))
diff --git a/lisp/subr.el b/lisp/subr.el
index 581e52e8f9d..2435285bf0f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4800,6 +4800,21 @@ which is higher than \"1alpha\", which is higher than \"1snapshot\".
4800Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions." 4800Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
4801 (version-list-= (version-to-list v1) (version-to-list v2))) 4801 (version-list-= (version-to-list v1) (version-to-list v2)))
4802 4802
4803(defvar package--builtin-versions
4804 ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
4805 (purecopy `((emacs . ,(version-to-list emacs-version))))
4806 "Alist giving the version of each versioned builtin package.
4807I.e. each element of the list is of the form (NAME . VERSION) where
4808NAME is the package name as a symbol, and VERSION is its version
4809as a list.")
4810
4811(defun package--description-file (dir)
4812 (concat (let ((subdir (file-name-nondirectory
4813 (directory-file-name dir))))
4814 (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
4815 (match-string 1 subdir) subdir))
4816 "-pkg.el"))
4817
4803 4818
4804;;; Misc. 4819;;; Misc.
4805(defconst menu-bar-separator '("--") 4820(defconst menu-bar-separator '("--")
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index ba59c75c4ec..fcb9fd55bb1 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -24,67 +24,6 @@
24 24
25;;; Code: 25;;; Code:
26 26
27(defcustom x-select-enable-clipboard t
28 "Non-nil means cutting and pasting uses the clipboard.
29This is in addition to, but in preference to, the primary selection.
30
31Note that MS-Windows does not support selection types other than the
32clipboard. (The primary selection that is set by Emacs is not
33accessible to other programs on MS-Windows.)
34
35This variable is not used by the Nextstep port."
36 :type 'boolean
37 :group 'killing
38 ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not.
39 :version "24.1")
40
41(defvar x-last-selected-text) ; w32-fns.el
42(declare-function w32-set-clipboard-data "w32select.c"
43 (string &optional ignored))
44(defvar ns-last-selected-text) ; ns-win.el
45(declare-function ns-set-pasteboard "ns-win" (string))
46
47(defvar x-select-enable-primary) ; x-win.el
48(defvar x-last-selected-text-primary)
49(defvar x-last-selected-text-clipboard)
50(defvar saved-region-selection) ; simple.el
51
52(defun x-select-text (text)
53 "Select TEXT, a string, according to the window system.
54
55On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
56clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
57the primary selection.
58
59On MS-Windows, make TEXT the current selection. If
60`x-select-enable-clipboard' is non-nil, copy the text to the
61clipboard as well.
62
63On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard'
64is not used)."
65 (cond ((eq (framep (selected-frame)) 'w32)
66 (if x-select-enable-clipboard
67 (w32-set-clipboard-data text))
68 (setq x-last-selected-text text))
69 ((featurep 'ns)
70 ;; Don't send the pasteboard too much text.
71 ;; It becomes slow, and if really big it causes errors.
72 (ns-set-pasteboard text)
73 (setq ns-last-selected-text text))
74 (t
75 ;; With multi-tty, this function may be called from a tty frame.
76 (when (eq (framep (selected-frame)) 'x)
77 (when x-select-enable-primary
78 (x-set-selection 'PRIMARY text)
79 (setq x-last-selected-text-primary text))
80 (when x-select-enable-clipboard
81 ;; When cutting, the selection is cleared and PRIMARY set to
82 ;; the empty string. Prevent that, PRIMARY should not be reset
83 ;; by cut (Bug#16382).
84 (setq saved-region-selection text)
85 (x-set-selection 'CLIPBOARD text)
86 (setq x-last-selected-text-clipboard text))))))
87
88;;;; Function keys 27;;;; Function keys
89 28
90(defvar x-alternatives-map 29(defvar x-alternatives-map
@@ -117,8 +56,7 @@ is not used)."
117 (set-keymap-parent map (keymap-parent local-function-key-map)) 56 (set-keymap-parent map (keymap-parent local-function-key-map))
118 (set-keymap-parent local-function-key-map map)) 57 (set-keymap-parent local-function-key-map map))
119 (when (featurep 'ns) 58 (when (featurep 'ns)
120 (setq interprogram-cut-function 'x-select-text 59 (setq interprogram-paste-function 'x-selection-value
121 interprogram-paste-function 'x-selection-value
122 system-key-alist 60 system-key-alist
123 (list 61 (list
124 ;; These are special "keys" used to pass events from C to lisp. 62 ;; These are special "keys" used to pass events from C to lisp.
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 47d953aebfb..fc13a2c5ddf 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -739,7 +739,6 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
739;; We keep track of the last text selected here, so we can check the 739;; We keep track of the last text selected here, so we can check the
740;; current selection against it, and avoid passing back our own text 740;; current selection against it, and avoid passing back our own text
741;; from x-selection-value. 741;; from x-selection-value.
742(defvar ns-last-selected-text nil)
743 742
744;; Return the value of the current Nextstep selection. For 743;; Return the value of the current Nextstep selection. For
745;; compatibility with older Nextstep applications, this checks cut 744;; compatibility with older Nextstep applications, this checks cut
@@ -751,13 +750,13 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
751 (if (string= text "") (setq text nil)) 750 (if (string= text "") (setq text nil))
752 (cond 751 (cond
753 ((not text) nil) 752 ((not text) nil)
754 ((eq text ns-last-selected-text) nil) 753 ((eq text gui-last-selected-text) nil)
755 ((string= text ns-last-selected-text) 754 ((string= text gui-last-selected-text)
756 ;; Record the newer string, so subsequent calls can use the `eq' test. 755 ;; Record the newer string, so subsequent calls can use the `eq' test.
757 (setq ns-last-selected-text text) 756 (setq gui-last-selected-text text)
758 nil) 757 nil)
759 (t 758 (t
760 (setq ns-last-selected-text text))))) 759 (setq gui-last-selected-text text)))))
761 760
762(defun ns-copy-including-secondary () 761(defun ns-copy-including-secondary ()
763 (interactive) 762 (interactive)
@@ -959,10 +958,18 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
959 958
960;; Any display name is OK. 959;; Any display name is OK.
961(add-to-list 'display-format-alist '(".*" . ns)) 960(add-to-list 'display-format-alist '(".*" . ns))
962(add-to-list 'handle-args-function-alist '(ns . x-handle-args)) 961(gui-method-define handle-args-function ns #'x-handle-args)
963(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces)) 962(gui-method-define frame-creation-function ns #'x-create-frame-with-faces)
964(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system)) 963(gui-method-define window-system-initialization ns
965 964 #'ns-initialize-window-system)
965
966(declare-function ns-set-pasteboard "ns-win" (string))
967(gui-method-define gui-select-text ns
968 (lambda (text)
969 ;; Don't send the pasteboard too much text.
970 ;; It becomes slow, and if really big it causes errors.
971 (when gui-select-enable-clipboard
972 (ns-set-pasteboard text))))
966 973
967(provide 'ns-win) 974(provide 'ns-win)
968 975
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index f24a54fbe28..264d881bc15 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -219,44 +219,10 @@ the operating system.")
219; 219;
220;;;; Selections 220;;;; Selections
221; 221;
222;;; We keep track of the last text selected here, so we can check the
223;;; current selection against it, and avoid passing back our own text
224;;; from x-selection-value.
225(defvar x-last-selected-text nil)
226
227(defcustom x-select-enable-clipboard t
228 "Non-nil means cutting and pasting uses the clipboard.
229This is in addition to, but in preference to, the primary selection.
230
231Note that MS-Windows does not support selection types other than the
232clipboard. (The primary selection that is set by Emacs is not
233accessible to other programs on MS-Windows.)
234
235This variable is not used by the Nextstep port."
236 :type 'boolean
237 :group 'killing)
238
239(defun x-select-text (text)
240 "Select TEXT, a string, according to the window system.
241
242On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
243clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
244the primary selection.
245
246On MS-Windows, make TEXT the current selection. If
247`x-select-enable-clipboard' is non-nil, copy the text to the
248clipboard as well.
249
250On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard'
251is not used)."
252 (if x-select-enable-clipboard
253 (w16-set-clipboard-data text))
254 (setq x-last-selected-text text))
255
256(defun x-get-selection-value () 222(defun x-get-selection-value ()
257 "Return the value of the current selection. 223 "Return the value of the current selection.
258Consult the selection. Treat empty strings as if they were unset." 224Consult the selection. Treat empty strings as if they were unset."
259 (if x-select-enable-clipboard 225 (if gui-select-enable-clipboard
260 (let (text) 226 (let (text)
261 ;; Don't die if x-get-selection signals an error. 227 ;; Don't die if x-get-selection signals an error.
262 (with-demoted-errors "w16-get-clipboard-data:%s" 228 (with-demoted-errors "w16-get-clipboard-data:%s"
@@ -264,13 +230,13 @@ Consult the selection. Treat empty strings as if they were unset."
264 (if (string= text "") (setq text nil)) 230 (if (string= text "") (setq text nil))
265 (cond 231 (cond
266 ((not text) nil) 232 ((not text) nil)
267 ((eq text x-last-selected-text) nil) 233 ((eq text gui-last-selected-text) nil)
268 ((string= text x-last-selected-text) 234 ((string= text gui-last-selected-text)
269 ;; Record the newer string, so subsequent calls can use the 'eq' test. 235 ;; Record the newer string, so subsequent calls can use the 'eq' test.
270 (setq x-last-selected-text text) 236 (setq gui-last-selected-text text)
271 nil) 237 nil)
272 (t 238 (t
273 (setq x-last-selected-text text)))))) 239 (setq gui-last-selected-text text))))))
274 240
275;; x-selection-owner-p is used in simple.el. 241;; x-selection-owner-p is used in simple.el.
276(defun x-selection-owner-p (&optional _selection _terminal) 242(defun x-selection-owner-p (&optional _selection _terminal)
@@ -288,7 +254,7 @@ frame's display, or the first available X display.
288On Nextstep, TERMINAL is unused. 254On Nextstep, TERMINAL is unused.
289 255
290\(fn &optional SELECTION TERMINAL)" 256\(fn &optional SELECTION TERMINAL)"
291 (if x-select-enable-clipboard 257 (if gui-select-enable-clipboard
292 (let (text) 258 (let (text)
293 ;; Don't die if w16-get-clipboard-data signals an error. 259 ;; Don't die if w16-get-clipboard-data signals an error.
294 (ignore-errors 260 (ignore-errors
@@ -298,8 +264,8 @@ On Nextstep, TERMINAL is unused.
298 ;; we've put into the Windows clipboard. 264 ;; we've put into the Windows clipboard.
299 (cond 265 (cond
300 ((not text) t) 266 ((not text) t)
301 ((or (eq text x-last-selected-text) 267 ((or (eq text gui-last-selected-text)
302 (string= text x-last-selected-text)) 268 (string= text gui-last-selected-text))
303 text) 269 text)
304 (t nil))))) 270 (t nil)))))
305 271
@@ -463,20 +429,27 @@ Errors out because it is not supposed to be called, ever."
463 (setq split-window-keep-point t) 429 (setq split-window-keep-point t)
464 ;; Arrange for the kill and yank functions to set and check the 430 ;; Arrange for the kill and yank functions to set and check the
465 ;; clipboard. 431 ;; clipboard.
466 (setq interprogram-cut-function 'x-select-text)
467 (setq interprogram-paste-function 'x-get-selection-value) 432 (setq interprogram-paste-function 'x-get-selection-value)
468 (menu-bar-enable-clipboard) 433 (menu-bar-enable-clipboard)
469 (run-hooks 'terminal-init-msdos-hook)) 434 (run-hooks 'terminal-init-msdos-hook))
470 435
471;; frame-creation-function-alist is examined by frame.el:make-frame. 436;; frame-creation-function-alist is examined by frame.el:make-frame.
472(add-to-list 'frame-creation-function-alist 437(gui-method-define frame-creation-function
473 '(pc . msdos-create-frame-with-faces)) 438 pc #'msdos-create-frame-with-faces)
474;; window-system-initialization-alist is examined by startup.el:command-line. 439;; window-system-initialization-alist is examined by startup.el:command-line.
475(add-to-list 'window-system-initialization-alist 440(gui-method-define window-system-initialization
476 '(pc . msdos-initialize-window-system)) 441 pc #'msdos-initialize-window-system)
477;; We don't need anything beyond tty-handle-args for handling 442;; We don't need anything beyond tty-handle-args for handling
478;; command-line argument; see startup.el. 443;; command-line argument; see startup.el.
479(add-to-list 'handle-args-function-alist '(pc . tty-handle-args)) 444(gui-method-define handle-args-function pc #'tty-handle-args)
445
446
447(declare-function w16-set-clipboard-data "w16select.c"
448 (string &optional ignored))
449(gui-method-define gui-select-text pc
450 (lambda (text)
451 (when gui-select-enable-clipboard
452 (w16-set-clipboard-data text))))
480 453
481;; --------------------------------------------------------------------------- 454;; ---------------------------------------------------------------------------
482 455
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index e103562ba7a..3eb8e69c28d 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -371,9 +371,18 @@ This returns an error if any Emacs frames are X frames, or always under W32."
371 (setq w32-initialized t)) 371 (setq w32-initialized t))
372 372
373(add-to-list 'display-format-alist '("\\`w32\\'" . w32)) 373(add-to-list 'display-format-alist '("\\`w32\\'" . w32))
374(add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) 374(gui-method-define handle-args-function w32 #'x-handle-args)
375(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) 375(gui-method-define frame-creation-function w32
376(add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system)) 376 #'x-create-frame-with-faces)
377(gui-method-define window-system-initialization w32
378 #'w32-initialize-window-system)
379
380(declare-function w32-set-clipboard-data "w32select.c"
381 (string &optional ignored))
382(gui-method-define gui-select-text w32
383 (lambda (text)
384 (if gui-select-enable-clipboard
385 (w32-set-clipboard-data text))))
377 386
378(provide 'w32-win) 387(provide 'w32-win)
379 388
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 964b9112553..daaef61e494 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1217,8 +1217,6 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
1217 (remove-text-properties 0 (length text) '(foreign-selection nil) text)) 1217 (remove-text-properties 0 (length text) '(foreign-selection nil) text))
1218 text)) 1218 text))
1219 1219
1220(defvar x-select-enable-clipboard) ; common-win
1221
1222;; Return the value of the current X selection. 1220;; Return the value of the current X selection.
1223;; Consult the selection. Treat empty strings as if they were unset. 1221;; Consult the selection. Treat empty strings as if they were unset.
1224;; If this function is called twice and finds the same text, 1222;; If this function is called twice and finds the same text,
@@ -1290,7 +1288,6 @@ The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
1290 'x-selection-value "24.1") 1288 'x-selection-value "24.1")
1291 1289
1292;; Arrange for the kill and yank functions to set and check the clipboard. 1290;; Arrange for the kill and yank functions to set and check the clipboard.
1293(setq interprogram-cut-function 'x-select-text)
1294(setq interprogram-paste-function 'x-selection-value) 1291(setq interprogram-paste-function 'x-selection-value)
1295 1292
1296;; Make paste from other applications use the decoding in x-select-request-type 1293;; Make paste from other applications use the decoding in x-select-request-type
@@ -1301,6 +1298,7 @@ Request data types in the order specified by `x-select-request-type'."
1301 (x-selection-value-internal 'PRIMARY)) 1298 (x-selection-value-internal 'PRIMARY))
1302 1299
1303(defun x-clipboard-yank () 1300(defun x-clipboard-yank ()
1301 ;; FIXME: How is that different from `clipboard-yank'?
1304 "Insert the clipboard contents, or the last stretch of killed text." 1302 "Insert the clipboard contents, or the last stretch of killed text."
1305 (interactive "*") 1303 (interactive "*")
1306 (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD)) 1304 (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD))
@@ -1463,9 +1461,23 @@ This returns an error if any Emacs frames are X frames, or always under W32."
1463 (setq x-initialized t)) 1461 (setq x-initialized t))
1464 1462
1465(add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x)) 1463(add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x))
1466(add-to-list 'handle-args-function-alist '(x . x-handle-args)) 1464(gui-method-define handle-args-function x #'x-handle-args)
1467(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces)) 1465(gui-method-define frame-creation-function x #'x-create-frame-with-faces)
1468(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system)) 1466(gui-method-define window-system-initialization x #'x-initialize-window-system)
1467
1468(defvar x-select-enable-primary) ; x-win.el
1469(gui-method-define gui-select-text x
1470 (lambda (text)
1471 (when x-select-enable-primary
1472 (x-set-selection 'PRIMARY text)
1473 (setq x-last-selected-text-primary text))
1474 (when x-select-enable-clipboard
1475 ;; When cutting, the selection is cleared and PRIMARY
1476 ;; set to the empty string. Prevent that, PRIMARY
1477 ;; should not be reset by cut (Bug#16382).
1478 (setq saved-region-selection text)
1479 (x-set-selection 'CLIPBOARD text)
1480 (setq x-last-selected-text-clipboard text))))
1469 1481
1470;; Initiate drag and drop 1482;; Initiate drag and drop
1471(add-hook 'after-make-frame-functions 'x-dnd-init-frame) 1483(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
diff --git a/lisp/w32-common-fns.el b/lisp/w32-common-fns.el
index d149500c327..343a4c25895 100644
--- a/lisp/w32-common-fns.el
+++ b/lisp/w32-common-fns.el
@@ -104,12 +104,11 @@ ignored on MS-Windows and MS-DOS."
104;; current selection against it, and avoid passing back our own text 104;; current selection against it, and avoid passing back our own text
105;; from x-selection-value. 105;; from x-selection-value.
106(defvar x-last-selected-text nil) 106(defvar x-last-selected-text nil)
107(defvar x-select-enable-clipboard)
108 107
109(defun x-get-selection-value () 108(defun x-get-selection-value ()
110 "Return the value of the current selection. 109 "Return the value of the current selection.
111Consult the selection. Treat empty strings as if they were unset." 110Consult the selection. Treat empty strings as if they were unset."
112 (if x-select-enable-clipboard 111 (if gui-select-enable-clipboard
113 (let (text) 112 (let (text)
114 ;; Don't die if x-get-selection signals an error. 113 ;; Don't die if x-get-selection signals an error.
115 (with-demoted-errors "w32-get-clipboard-data:%s" 114 (with-demoted-errors "w32-get-clipboard-data:%s"
@@ -128,7 +127,6 @@ Consult the selection. Treat empty strings as if they were unset."
128(defalias 'x-selection-value 'x-get-selection-value) 127(defalias 'x-selection-value 'x-get-selection-value)
129 128
130;; Arrange for the kill and yank functions to set and check the clipboard. 129;; Arrange for the kill and yank functions to set and check the clipboard.
131(setq interprogram-cut-function 'x-select-text)
132(setq interprogram-paste-function 'x-get-selection-value) 130(setq interprogram-paste-function 'x-get-selection-value)
133 131
134(provide 'w32-common-fns) 132(provide 'w32-common-fns)
diff --git a/src/xselect.c b/src/xselect.c
index 0e8a43717e0..a06243f5924 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -2638,12 +2638,14 @@ syms_of_xselect (void)
2638 converted_selections = NULL; 2638 converted_selections = NULL;
2639 conversion_fail_tag = None; 2639 conversion_fail_tag = None;
2640 2640
2641 /* FIXME: Duplicate definition in nsselect.c. */
2641 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist, 2642 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
2642 doc: /* An alist associating X Windows selection-types with functions. 2643 doc: /* An alist associating X Windows selection-types with functions.
2643These functions are called to convert the selection, with three args: 2644These functions are called to convert the selection, with three args:
2644the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); 2645the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2645a desired type to which the selection should be converted; 2646a desired type to which the selection should be converted;
2646and the local selection value (whatever was given to `x-own-selection'). 2647and the local selection value (whatever was given to
2648`x-own-selection-internal').
2647 2649
2648The function should return the value to send to the X server 2650The function should return the value to send to the X server
2649\(typically a string). A return value of nil 2651\(typically a string). A return value of nil