Index: lisp/loadup.el =================================================================== RCS file: /sources/emacs/emacs/lisp/loadup.el,v retrieving revision 1.160 diff -U 8 -r1.160 loadup.el --- lisp/loadup.el 1 Feb 2008 22:43:10 -0000 1.160 +++ lisp/loadup.el 17 Feb 2008 03:01:28 -0000 @@ -77,16 +77,17 @@ (load "button") (load "startup") (message "Lists of integers (garbage collection statistics) are normal output") (message "while building Emacs; they do not indicate a problem.") (message "%s" (garbage-collect)) (load "loaddefs.el") ;Don't get confused if someone compiled this by mistake. (message "%s" (garbage-collect)) +(load "emacs-lisp/timer") ; needed for propagate-active-region in simple (load "simple") (load "help") (load "jka-cmpr-hook") ;; Any Emacs Lisp source file (*.el) loaded here after can contain ;; multilingual text. (load "international/mule-cmds") @@ -140,17 +141,16 @@ (load "jit-lock") (if (fboundp 'track-mouse) (progn (load "mouse") (and (boundp 'x-toolkit-scroll-bars) (load "scroll-bar")) (load "select"))) -(load "emacs-lisp/timer") (load "isearch") (load "rfn-eshadow") (message "%s" (garbage-collect)) (load "menu-bar") (load "paths.el") ;Don't get confused if someone compiled paths by mistake. (load "emacs-lisp/lisp") (load "textmodes/page") Index: lisp/w32-vars.el =================================================================== RCS file: /sources/emacs/emacs/lisp/w32-vars.el,v retrieving revision 1.19 diff -U 8 -r1.19 w32-vars.el --- lisp/w32-vars.el 8 Jan 2008 20:44:48 -0000 1.19 +++ lisp/w32-vars.el 17 Feb 2008 03:01:28 -0000 @@ -144,18 +144,20 @@ (repeat :inline t (choice :tag "" (const :tag "Separator" ("")) (list :tag "Font Entry" (string :tag "Menu text") (string :tag "Font"))))))) :group 'w32) -(defcustom x-select-enable-clipboard t - "*Non-nil means cutting and pasting uses the clipboard. -This is in addition to the primary selection." - :type 'boolean - :group 'killing) +;; There is now a enable-system-clipboard flag in simple.el +;; +;;(defcustom x-select-enable-clipboard t +;; "*Non-nil means cutting and pasting uses the clipboard. +;;This is in addition to the primary selection." +;; :type 'boolean +;; :group 'killing) (provide 'w32-vars) ;;; arch-tag: ee2394fb-9db7-4c15-a8f0-66b47f4a2bb1 ;;; w32-vars.el ends here Index: lisp/simple.el =================================================================== RCS file: /sources/emacs/emacs/lisp/simple.el,v retrieving revision 1.901 diff -U 8 -r1.901 simple.el --- lisp/simple.el 12 Feb 2008 02:25:08 -0000 1.901 +++ lisp/simple.el 17 Feb 2008 03:01:34 -0000 @@ -2544,28 +2544,31 @@ (if noprops (set-text-properties 0 (length string) nil string)) string))) (noprops (buffer-substring-no-properties beg end)) (t (buffer-substring beg end)))) - ;;;; Window system cut and paste hooks. (defvar interprogram-cut-function nil "Function to call to make a killed region available to other programs. Most window systems provide some sort of facility for cutting and pasting text between the windows of different programs. This variable holds a function that Emacs calls whenever text is put in the kill ring, to make the new kill available to other programs. +This function should respect `enable-system-clipboard' and +`enable-system-current-selection' if possible. It may also honour +the value of window-system-specific customisations. + The function takes one or two arguments. The first argument, TEXT, is a string containing the text which should be made available. The second, optional, argument PUSH, has the same meaning as the similar argument to `x-set-cut-buffer', which see.") (defvar interprogram-paste-function nil "Function to call to get text cut from other programs. @@ -2581,22 +2584,28 @@ string, then the caller of the function \(usually `current-kill') should put this string in the kill ring as the latest kill. This function may also return a list of strings if the window system supports multiple selections. The first string will be used as the pasted text, but the other will be placed in the kill ring for easy access via `yank-pop'. -Note that the function should return a string only if a program other -than Emacs has provided a string for pasting; if Emacs provided the -most recent string, the function should return nil. If it is -difficult to tell whether Emacs or some other program provided the -current string, it is probably good enough to return nil if the string -is equal (according to `string=') to the last text Emacs provided.") +This function should respect `enable-system-clipboard' and +`enable-system-current-selection' if possible. It may also honour +the value of window-system-specific customisations. + +Note that, unless `enable-kill-ring' is nil, the function should +return a string only if a program other than Emacs has provided a +string for pasting; if Emacs provided the most recent string, the +function should return nil. If `enable-kill-ring' is nil, the +function should just always return what it finds, if anything. +If it is difficult to tell whether Emacs or some other program provided +the current string, it is probably good enough to return nil if the +string is equal (according to `string=') to the last text Emacs provided.") ;;;; The kill ring data structure. (defvar kill-ring nil "List of killed text sequences. Since the kill ring is supposed to interact nicely with cut-and-paste @@ -2607,50 +2616,76 @@ interaction; you may want to use them instead of manipulating the kill ring directly.") (defcustom kill-ring-max 60 "*Maximum length of kill ring before oldest elements are thrown away." :type 'integer :group 'killing) +(defcustom enable-system-clipboard nil + "Non-nil means emacs killing and yanking uses the system clipboard." + :type 'boolean + :group 'killing + :version "23.1") + +(defcustom enable-system-current-selection t + "Non-nil means emacs killing and yanking uses the system current selection. +Your windowing system may not provide a current selection tracking +facility. If it doesn't, emacs may or may not emulate it." + :type 'boolean + :group 'killing + :version "23.1") + (defvar kill-ring-yank-pointer nil "The tail of the kill ring whose car is the last thing yanked.") +(defvar enable-kill-ring t + "If nil, then 'killing' won't actually affect the kill ring +and 'yanking' won't actually draw on or affect the kill ring. +Only `interprogram-cut-function' and `interprogram-paste-function' +will be used. This is useful for conforming to X11 desktop +conventions.") + (defun kill-new (string &optional replace yank-handler) "Make STRING the latest kill in the kill ring. Set `kill-ring-yank-pointer' to point to it. If `interprogram-cut-function' is non-nil, apply it to STRING. Optional second argument REPLACE non-nil means that STRING will replace the front of the kill ring, rather than being added to the list. +If variable `enable-kill-ring' is nil, then this function +will not affect the kill ring, but `interprogram-cut-function' may +be called. + Optional third arguments YANK-HANDLER controls how the STRING is later inserted into a buffer; see `insert-for-yank' for details. When a yank handler is specified, STRING must be non-empty (the yank handler, if non-nil, is stored as a `yank-handler' text property on STRING). When the yank handler has a non-nil PARAM element, the original STRING argument is not used by `insert-for-yank'. However, since Lisp code may access and use elements from the kill ring directly, the STRING argument should still be a \"useful\" string for such uses." - (if (> (length string) 0) + (when enable-kill-ring + (if (> (length string) 0) + (if yank-handler + (put-text-property 0 (length string) + 'yank-handler yank-handler string)) (if yank-handler - (put-text-property 0 (length string) - 'yank-handler yank-handler string)) - (if yank-handler - (signal 'args-out-of-range - (list string "yank-handler specified for empty string")))) - (if (fboundp 'menu-bar-update-yank-menu) - (menu-bar-update-yank-menu string (and replace (car kill-ring)))) - (if (and replace kill-ring) - (setcar kill-ring string) - (push string kill-ring) - (if (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) - (setq kill-ring-yank-pointer kill-ring) + (signal 'args-out-of-range + (list string "yank-handler specified for empty string")))) + (if (fboundp 'menu-bar-update-yank-menu) + (menu-bar-update-yank-menu string (and replace (car kill-ring)))) + (if (and replace kill-ring) + (setcar kill-ring string) + (push string kill-ring) + (if (> (length kill-ring) kill-ring-max) + (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) + (setq kill-ring-yank-pointer kill-ring)) (if interprogram-cut-function (funcall interprogram-cut-function string (not replace)))) (defun kill-append (string before-p &optional yank-handler) "Append STRING to the end of the latest kill in the kill ring. If BEFORE-P is non-nil, prepend STRING to the kill. Optional third argument YANK-HANDLER, if non-nil, specifies the yank-handler text property to be set on the combined kill ring @@ -2660,63 +2695,81 @@ instead of replacing the last kill with it. If `interprogram-cut-function' is set, pass the resulting kill to it." (let* ((cur (car kill-ring))) (kill-new (if before-p (concat string cur) (concat cur string)) (or (= (length cur) 0) (equal yank-handler (get-text-property 0 'yank-handler cur))) yank-handler))) -(defcustom yank-pop-change-selection nil + +(defcustom yank-pop-change-system-current-selection nil "If non-nil, rotating the kill ring changes the window system selection." :type 'boolean :group 'killing :version "23.1") +(defcustom yank-pop-change-system-clipboard nil + "If non-nil, rotating the kill ring changes the window system clipboard" + :type 'boolean + :group 'killing + :version "23.1") + (defun current-kill (n &optional do-not-move) "Rotate the yanking point by N places, and then return that kill. If N is zero, `interprogram-paste-function' is set, and calling it returns a string or list of strings, then that string (or list) is added to the front of the kill ring and the string (or first string in the list) is returned as -the latest kill. +the latest kill. However, if variable `enable-kill-ring' is +nil, then the kill ring will not be affected, nor will it be used to find +the yanked text - only `interprogram-paste-function' will be used. If N is not zero, and if `yank-pop-change-selection' is non-nil, use `interprogram-cut-function' to transfer the kill at the new yank point into the window system selection. + If optional arg DO-NOT-MOVE is non-nil, then don't actually move the yanking point; just return the Nth kill forward." (let ((interprogram-paste (and (= n 0) interprogram-paste-function (funcall interprogram-paste-function)))) - (if interprogram-paste + (if enable-kill-ring (progn - ;; Disable the interprogram cut function when we add the new - ;; text to the kill ring, so Emacs doesn't try to own the - ;; selection, with identical text. - (let ((interprogram-cut-function nil)) - (if (listp interprogram-paste) - (mapc 'kill-new (nreverse interprogram-paste)) - (kill-new interprogram-paste))) - (car kill-ring)) - (or kill-ring (error "Kill ring is empty")) - (let ((ARGth-kill-element - (nthcdr (mod (- n (length kill-ring-yank-pointer)) - (length kill-ring)) - kill-ring))) - (unless do-not-move - (setq kill-ring-yank-pointer ARGth-kill-element) - (when (and yank-pop-change-selection - (> n 0) - interprogram-cut-function) - (funcall interprogram-cut-function (car ARGth-kill-element)))) - (car ARGth-kill-element))))) - - + (if interprogram-paste + (progn + ;; Disable the interprogram cut function when we add the new + ;; text to the kill ring, so Emacs doesn't try to own the + ;; selection, with identical text. + (let ((interprogram-cut-function nil)) + (if (listp interprogram-paste) + (mapc 'kill-new (nreverse interprogram-paste)) + (kill-new interprogram-paste))) + (car kill-ring)) + (or kill-ring (error "Kill ring is empty")) + (let ((ARGth-kill-element + (nthcdr (mod (- n (length kill-ring-yank-pointer)) + (length kill-ring)) + kill-ring))) + (unless do-not-move + (setq kill-ring-yank-pointer ARGth-kill-element) + (when (and (or yank-pop-change-system-current-selection + yank-pop-change-system-clipboard) + (> n 0) + interprogram-cut-function) + (let ((enable-system-clipboard yank-pop-change-system-clipboard) + (enable-system-current-selection yank-pop-change-system-current-selection)) + (funcall interprogram-cut-function (car ARGth-kill-element))))) + (car ARGth-kill-element)))) + (if interprogram-paste + (if (listp interprogram-paste) + (car interprogram-paste) + interprogram-paste) + (error "No system selections found and kill ring is off for this operation."))))) ;;;; Commands for manipulating the kill ring. (defcustom kill-read-only-ok nil "*Non-nil means don't signal an error for killing read-only text." :type 'boolean :group 'killing) @@ -3305,35 +3358,93 @@ is active, and returns an integer or nil in the usual way. If you are using this in an editing command, you are most likely making a mistake; see the documentation of `set-mark'." (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive) (marker-position (mark-marker)) (signal 'mark-inactive nil))) +(defvar propagate-active-region-last-region nil + "record of last propagated region for comparison +in `propagate-active-region'") + +(defvar propagate-active-region-replace nil + "used to trim kill-ring growth in propagate-active-region, +for when active-region-enable-kill-ring is non-nil.") + ;; Many places set mark-active directly, and several of them failed to also ;; run deactivate-mark-hook. This shorthand should simplify. (defsubst deactivate-mark () "Deactivate the mark by setting `mark-active' to nil. \(That makes a difference only in Transient Mark mode.) Also runs the hook `deactivate-mark-hook'." + (cancel-function-timers 'propagate-active-region) + (setq propagate-active-region-replace nil) + (setq propagate-active-region-last-region nil) (cond ((eq transient-mark-mode 'lambda) (setq transient-mark-mode nil)) (transient-mark-mode (setq mark-active nil) (run-hooks 'deactivate-mark-hook)))) -(defcustom select-active-regions nil - "If non-nil, an active region automatically becomes the window selection." + +(defcustom active-region-enable-system-clipboard nil + "If non-nil, an active region automatically updates the system clipboard. +This happens without any explicit kill." + :type 'boolean + :group 'killing + :version "23.1") + +(defcustom active-region-enable-system-current-selection nil + "If non-nil, an active region automatically updates the system current selection. +This happens without any explicit kill." :type 'boolean :group 'killing :version "23.1") +(defcustom active-region-enable-kill-ring nil + "If non-nil, an active region automatically becomes head of the kill ring. +This happens without any explicit kill." + :type 'boolean + :group 'killing + :version "23.1") + + +(defun propagate-active-region () + "Implements `active-regions-enable-system-clipboard' + + Called by an idle timer active when region is active and `set-mark'" + (and (or active-region-enable-system-clipboard + active-region-enable-system-current-selection + active-region-enable-kill-ring) + (region-active-p) + (let ((maybe-propagate-current-region-text + (buffer-substring (region-beginning) (region-end)))) + (when (or (null propagate-active-region-last-region) + (not (string= propagate-active-region-last-region + maybe-propagate-current-region-text))) + (setq propagate-active-region-last-region + maybe-propagate-current-region-text) + (if (or (null maybe-propagate-current-region-text) + (string= "" maybe-propagate-current-region-text)) + ;; don't propagate if this region is empty, but this + ;; region being empty means future nonempty regions + ;; need repropagation + (setq propagate-active-region-last-region nil) + (let ((enable-system-clipboard active-region-enable-system-clipboard) + (enable-system-current-selection + active-region-enable-system-current-selection) + (enable-kill-ring active-region-enable-kill-ring)) + (kill-new maybe-propagate-current-region-text + propagate-active-region-replace) + (setq propagate-active-region-replace t))))))) + + (defun set-mark (pos) "Set this buffer's mark to POS. Don't use this function! That is to say, don't use this function unless you want the user to see that the mark has moved, and you want the previous mark position to be lost. Normally, when a new mark is set, the old one should go on the stack. This is why most applications should use `push-mark', not `set-mark'. @@ -3345,19 +3456,25 @@ store it in a Lisp variable. Example: (let ((beg (point))) (forward-line 1) (delete-region beg (point)))." (if pos (progn (setq mark-active t) (run-hooks 'activate-mark-hook) - (and select-active-regions - (x-set-selection - nil (buffer-substring (region-beginning) (region-end)))) + (when (or active-region-enable-system-clipboard + active-region-enable-system-current-selection + active-region-enable-kill-ring) + (cancel-function-timers 'propagate-active-region) + (run-with-idle-timer 0 t + 'propagate-active-region) + ; force immediate repropagate if mark is reset + (setq propagate-active-region-last-region nil) + (propagate-active-region)) (set-marker (mark-marker) pos (current-buffer))) ;; Normally we never clear mark-active except in Transient Mark mode. ;; But when we actually clear out the mark value too, ;; we must clear mark-active in any mode. (setq mark-active nil) (run-hooks 'deactivate-mark-hook) (set-marker (mark-marker) nil))) Index: lisp/mouse.el =================================================================== RCS file: /sources/emacs/emacs/lisp/mouse.el,v retrieving revision 1.327 diff -U 8 -r1.327 mouse.el --- lisp/mouse.el 7 Feb 2008 06:20:25 -0000 1.327 +++ lisp/mouse.el 17 Feb 2008 03:01:37 -0000 @@ -1351,30 +1351,52 @@ (mouse-minibuffer-check click) (let* ((posn (event-start click)) (click-posn (posn-point posn))) (select-window (posn-window posn)) (if (numberp click-posn) (kill-region (min (point) click-posn) (max (point) click-posn))))) +(defcustom mouse-yank-enable-system-clipboard nil + "If non-nil, \\[mouse-yank-at-click] uses the system clipboard." + :type 'boolean + :group 'mouse + :version "23.1") + +(defcustom mouse-yank-enable-system-current-selection t + "If non-nil, \\[mouse-yank-at-click] uses the system current selection." + :type 'boolean + :group 'mouse + :version "23.1") + +(defcustom mouse-yank-enable-kill-ring t + "If non-nil, \\[mouse-yank-at-click] uses the kill ring." + :type 'boolean + :group 'mouse + :version "23.1") + (defun mouse-yank-at-click (click arg) "Insert the last stretch of killed text at the position clicked on. Also move point to one end of the text thus inserted (normally the end), and set mark at the beginning. Prefix arguments are interpreted as with \\[yank]. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." (interactive "e\nP") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) - (setq this-command 'yank) - (setq mouse-selection-click-count 0) - (yank arg)) + (let ((enable-kill-ring mouse-yank-enable-kill-ring) + (enable-system-clipboard mouse-yank-enable-system-clipboard) + (enable-system-current-selection + mouse-yank-enable-system-current-selection)) + (setq this-command 'yank) + (setq mouse-selection-click-count 0) + (yank arg))) (defun mouse-yank-primary (click) "Insert the primary selection at the position clicked on. Move point to the end of the inserted text. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. Index: lisp/menu-bar.el =================================================================== RCS file: /sources/emacs/emacs/lisp/menu-bar.el,v retrieving revision 1.318 diff -U 8 -r1.318 menu-bar.el --- lisp/menu-bar.el 8 Jan 2008 20:44:39 -0000 1.318 +++ lisp/menu-bar.el 17 Feb 2008 03:01:39 -0000 @@ -508,32 +508,51 @@ '(and mark-active (not buffer-read-only))) (put 'clipboard-kill-ring-save 'menu-enable 'mark-active) (put 'clipboard-yank 'menu-enable '(and (or (and (fboundp 'x-selection-exists-p) (x-selection-exists-p)) (x-selection-exists-p 'CLIPBOARD)) (not buffer-read-only))) + +(defcustom menu-bar-enable-system-clipboard t + "If non-nil, menu bar cut/copy/paste uses the system clipboard." + :type 'boolean + :group 'menu + :version "23.1") + +(defcustom menu-bar-enable-system-current-selection nil + "If non-nil, menu bar cut/copy/paste uses the system current selection." + :type 'boolean + :group 'menu + :version "23.1") + (defun clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((x-select-enable-clipboard t)) + (let ((enable-system-clipboard menu-bar-enable-system-clipboard) + (enable-system-current-selection + menu-bar-enable-system-current-selection)) (yank))) (defun clipboard-kill-ring-save (beg end) "Copy region to kill ring, and save in the X clipboard." (interactive "r") - (let ((x-select-enable-clipboard t)) + (let ((enable-system-clipboard menu-bar-enable-system-clipboard) + (enable-system-current-selection + menu-bar-enable-system-current-selection)) (kill-ring-save beg end))) (defun clipboard-kill-region (beg end) "Kill the region, and save it in the X clipboard." (interactive "r") - (let ((x-select-enable-clipboard t)) + (let ((enable-system-clipboard menu-bar-enable-system-clipboard) + (enable-system-current-selection + menu-bar-enable-system-current-selection)) (kill-region beg end))) (defun menu-bar-enable-clipboard () "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard. Do the same for the keys of the same name." (interactive) ;; We can't use constant list structure here because it becomes pure, ;; and because it gets modified with cache data. Index: lisp/term/x-win.el =================================================================== RCS file: /sources/emacs/emacs/lisp/term/x-win.el,v retrieving revision 1.224 diff -U 8 -r1.224 x-win.el --- lisp/term/x-win.el 8 Feb 2008 08:33:23 -0000 1.224 +++ lisp/term/x-win.el 17 Feb 2008 03:01:41 -0000 @@ -2150,52 +2150,76 @@ This is the actual text stored in the X cut buffer.") (defvar x-last-cut-buffer-coding 'iso-latin-1 "The coding we last used to encode/decode the text from the X cut buffer") (defvar x-cut-buffer-max 20000 ; Note this value is overridden below. "Max number of characters to put in the cut buffer. It is said that overlarge strings are slow to put into the cut buffer.") -(defcustom x-select-enable-clipboard nil - "Non-nil means cutting and pasting uses the clipboard. -This is in addition to, but in preference to, the primary selection." - :type 'boolean - :group 'killing) - -(defcustom x-select-enable-primary t - "Non-nil means cutting and pasting uses the primary selection." - :type 'boolean - :group 'killing) + +;; A special layer of indirection on X11 to keep +;; the freedesktop.org averse happy and indicate +;; if legacy cutbuffers should be used. Other platforms +;; ...probably don't need this. + +(defcustom x-system-clipboard-is-x-selection '(:clipboard) + "Which X Selection(s) mean the 'system clipboard'." + :type '(set (const :clipboard) + (const :primary) + (const :cutbuffer)) + :group 'x + :version "23.1") + +(defcustom x-system-current-selection-is-x-selection '(:primary :cutbuffer) + "Which X Selection(s) mean the 'system current selection'." + :type '(set (const :clipboard) + (const :primary) + (const :cutbuffer)) + :group 'x + :version "23.1") + +(defun use-x-selection-p (sel) + "Test if x-level selection or cutbuffer should be +used according to `enable-system-clipboard', +`enable-system-current-selection' matched against +`x-system-clipboard-is-x-selection' and +`x-system-current-selection-is-x-selection'" +(or + (when enable-system-clipboard + (memq sel x-system-clipboard-is-x-selection)) + (when enable-system-current-selection + (memq sel x-system-current-selection-is-x-selection)))) (defun x-select-text (text &optional push) "Make TEXT, a string, the primary X selection. Also, set the value of X cut buffer 0, for backward compatibility with older X applications. address@hidden says it's not desirable to put kills in the clipboard." ;; With multi-tty, this function may be called from a tty frame. (when (eq (framep (selected-frame)) 'x) - ;; Don't send the cut buffer too much text. - ;; It becomes slow, and if really big it causes errors. - (cond ((>= (length text) x-cut-buffer-max) - (x-set-cut-buffer "" push) - (setq x-last-selected-text-cut "" - x-last-selected-text-cut-encoded "")) - (t - (setq x-last-selected-text-cut text - x-last-cut-buffer-coding 'iso-latin-1 - x-last-selected-text-cut-encoded - ;; ICCCM says cut buffer always contain ISO-Latin-1 - (encode-coding-string text 'iso-latin-1)) - (x-set-cut-buffer x-last-selected-text-cut-encoded push))) - (when x-select-enable-primary + (when (use-x-selection-p :cutbuffer) + ;; Don't send the cut buffer too much text. + ;; It becomes slow, and if really big it causes errors. + (cond ((>= (length text) x-cut-buffer-max) + (x-set-cut-buffer "" push) + (setq x-last-selected-text-cut "" + x-last-selected-text-cut-encoded "")) + (t + (setq x-last-selected-text-cut text + x-last-cut-buffer-coding 'iso-latin-1 + x-last-selected-text-cut-encoded + ;; ICCCM says cut buffer always contain ISO-Latin-1 + (encode-coding-string text 'iso-latin-1)) + (x-set-cut-buffer x-last-selected-text-cut-encoded push)))) + (when (use-x-selection-p :primary) (x-set-selection 'PRIMARY text) (setq x-last-selected-text-primary text)) - (when x-select-enable-clipboard + (when (use-x-selection-p :clipboard) (x-set-selection 'CLIPBOARD text) (setq x-last-selected-text-clipboard text)))) (defvar 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' @@ -2236,84 +2260,91 @@ ;; 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. (defun x-cut-buffer-or-selection-value () ;; With multi-tty, this function may be called from a tty frame. (when (eq (framep (selected-frame)) 'x) (let (clip-text primary-text cut-text) - (when x-select-enable-clipboard + (when (use-x-selection-p :clipboard) (setq clip-text (x-selection-value 'CLIPBOARD)) (if (string= clip-text "") (setq clip-text nil)) + + (when enable-kill-ring + ;; Check the CLIPBOARD selection for 'newness', is it different + ;; from what we remebered 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)))))) - ;; Check the CLIPBOARD selection for 'newness', is it different - ;; from what we remebered 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 + (when (use-x-selection-p :primary) (setq primary-text (x-selection-value 'PRIMARY)) - ;; Check the PRIMARY selection for 'newness', is it different - ;; from what we remebered 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))))) - - (setq cut-text (x-get-cut-buffer 0)) - - ;; Check the x cut buffer for 'newness', is it different - ;; from what we remebered them to be last time we did a - ;; cut/paste operation. - (setq cut-text - (let ((next-coding (or next-selection-coding-system 'iso-latin-1))) - (cond ;; check cut buffer - ((or (not cut-text) (string= cut-text "")) - (setq x-last-selected-text-cut nil)) - ;; This short cut doesn't work because x-get-cut-buffer - ;; always returns a newly created string. - ;; ((eq cut-text x-last-selected-text-cut) nil) - ((and (string= cut-text x-last-selected-text-cut-encoded) - (eq x-last-cut-buffer-coding next-coding)) - ;; See the comment above. No need of this recording. - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - ;; (setq x-last-selected-text-cut cut-text) - nil) - (t - (setq x-last-selected-text-cut-encoded cut-text - x-last-cut-buffer-coding next-coding - x-last-selected-text-cut - ;; ICCCM says cut buffer always contain ISO-Latin-1, but - ;; use next-selection-coding-system if not nil. - (decode-coding-string - cut-text next-coding)))))) - - ;; As we have done one selection, clear this now. - (setq next-selection-coding-system nil) + (if (string= primary-text "") (setq primary-text nil)) + (when enable-kill-ring + ;; Check the PRIMARY selection for 'newness', is it different + ;; from what we remebered 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)))))) + + (when (use-x-selection-p :cutbuffer) + (setq cut-text (x-get-cut-buffer 0)) + (if (string= cut-text "") (setq cut-text nil)) + + ;; Check the x cut buffer for 'newness', is it different + ;; from what we remebered them to be last time we did a + ;; cut/paste operation. + (setq cut-text + (let ((next-coding (or next-selection-coding-system 'iso-latin-1))) + (cond ;; check cut buffer + ((or (not cut-text) (string= cut-text "")) + (setq x-last-selected-text-cut nil)) + ;; This short cut doesn't work because x-get-cut-buffer + ;; always returns a newly created string. + ;; ((eq cut-text x-last-selected-text-cut) nil) + ((and (string= cut-text x-last-selected-text-cut-encoded) + (eq x-last-cut-buffer-coding next-coding)) + ;; See the comment above. No need of this recording. + ;; Record the newer string, + ;; so subsequent calls can use the `eq' test. + ;; (setq x-last-selected-text-cut cut-text) + (if enable-kill-ring + nil + cut-text)) + (t + (setq x-last-selected-text-cut-encoded cut-text + x-last-cut-buffer-coding next-coding + x-last-selected-text-cut + ;; ICCCM says cut buffer always contain ISO-Latin-1, but + ;; use next-selection-coding-system if not nil. + (decode-coding-string + cut-text next-coding)))))) + + ;; 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) primary, ;; and cut buffer. 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 @@ -2332,25 +2363,16 @@ ;; checked again). (or clip-text primary-text cut-text) ))) ;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text) (setq interprogram-paste-function 'x-cut-buffer-or-selection-value) -(defun x-clipboard-yank () - "Insert the clipboard contents, or the last stretch of killed text." - (interactive "*") - (let ((clipboard-text (x-selection-value 'CLIPBOARD)) - (x-select-enable-clipboard t)) - (if (and clipboard-text (> (length clipboard-text) 0)) - (kill-new clipboard-text)) - (yank))) - (defun x-menu-bar-open (&optional frame) "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'." (interactive "i") (if menu-bar-mode (accelerate-menu frame) (tmm-menubar))) ;;; Window system initialization. @@ -2455,23 +2477,16 @@ ;; (global-set-key [f10] 'ignore)) ;; Turn on support for mouse wheels. (mouse-wheel-mode 1) ;; Enable CLIPBOARD copy/paste through menu bar commands. (menu-bar-enable-clipboard) - ;; Override Paste so it looks at CLIPBOARD first. - (define-key menu-bar-edit-menu [paste] - (append '(menu-item "Paste" x-clipboard-yank - :enable (not buffer-read-only) - :help "Paste (yank) text most recently cut/copied") - nil)) - (setq x-initialized t)) (add-to-list 'handle-args-function-alist '(x . x-handle-args)) (add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces)) (add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system)) ;; Initiate drag and drop (add-hook 'after-make-frame-functions 'x-dnd-init-frame)