Index: lisp/w32-vars.el =================================================================== RCS file: /sources/emacs/emacs/lisp/w32-vars.el,v retrieving revision 1.19 diff -U 8 -d -r1.19 w32-vars.el --- lisp/w32-vars.el 8 Jan 2008 20:44:48 -0000 1.19 +++ lisp/w32-vars.el 7 Feb 2008 03:43:34 -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) +;; Why is this here? For that matter, why is +;; this file being loaded in a linux/X11 build of emacs? +;;(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/loadup.el =================================================================== RCS file: /sources/emacs/emacs/lisp/loadup.el,v retrieving revision 1.160 diff -U 8 -d -r1.160 loadup.el --- lisp/loadup.el 1 Feb 2008 22:43:10 -0000 1.160 +++ lisp/loadup.el 7 Feb 2008 03:43:35 -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") ; select-active-regions in simple.el needs timer. (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/simple.el =================================================================== RCS file: /sources/emacs/emacs/lisp/simple.el,v retrieving revision 1.899 diff -U 8 -d -r1.899 simple.el --- lisp/simple.el 1 Feb 2008 16:01:05 -0000 1.899 +++ lisp/simple.el 7 Feb 2008 03:43:41 -0000 @@ -2545,18 +2545,19 @@ (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. +;;;; Window system cut/paste and highlight/lightins hooks. +;; given multi-tty, shouldn't these be frame-local? (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. @@ -2586,17 +2587,67 @@ 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.") +is equal \(according to `string=') to the last text Emacs provided.") + +(defvar interprogram-highlight-function nil + "Function to call to make an active region available to other progams. + +In addition to clibpoard cutting and pasting \(see `interprogram-cut-function' +and `interprogram-paste-function'), at least one window system \(X11) +provides a mechanism whereby text merely highlighted in one application may + be immediately inserted into another. This variable holds a function that +`maybe-select-for-select-active-regions' calls whenever text is notionally +highlighted in emacs - i.e. there is an active region +\(see `transient-mark-mode'), and `select-active-regions'is active. + +The function takes one or two arguments, +The first argument, TEXT, is a string containing +the text that 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-lightins-function nil + "Function to call to get text made available for lightweight +insertion from other programs. + +At least one window system (X11) provides a facility for immediately +inserting text highlighted in one program into another, bypassing +the clipboard. + +This variable holds a function that Emacs calls to obtain +text that other programs have provided for such 'lightweight +insertion'. The convention has developed on X11 +that this lightweight highlight/insertion should be entirely +independent from the clipboard proper. + +The function should be called with no arguments. If the function +returns nil, then no other program has provided such text. If the +function returns a string, then the caller of the function +\(usually `mouse-yank-at-click') will insert this string +into the buffer... without affecting the kill ring. This may +seem slightly strange, but is intended and now typical +behaviour on X11 desktops. If you DO want mouse-yank-at-click to +affect the kill ring, as it has done in the past in emacs, +adjust `mouse-yank-at-click-source' to have it use the kill +ring \(and thereby potentially `interprogram-paste-function'), which +on X11 at least \(the only relevant platform at the moment) can +in turn be adjusted to pull in PRIMARY as well as or instead of +CLIPBOARD via `x-select-enable-primary'. + +Note that the function should return a string if available +whether or not a program other than Emacs provided the string, +this is so that emacs->emacs highlight/lightins interactions +work as expected.") ;;;; 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 @@ -3310,54 +3361,105 @@ (marker-position (mark-marker)) (signal 'mark-inactive 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'." +Also runs the hook `deactivate-mark-hook', and removes +any installed `select-active-regions' idle timer." + (and select-active-regions + (cancel-function-timers 'maybe-select-for-select-active-regions)) (cond ((eq transient-mark-mode 'lambda) (setq transient-mark-mode nil)) (transient-mark-mode (setq mark-active nil) (run-hooks 'deactivate-mark-hook)))) +(defvar select-active-regions-last-region nil + "record of last propagated region for comparison +in `maybe-select-for-select-active-regions'") + (defcustom select-active-regions nil - "If non-nil, an active region automatically becomes the window selection." + "If non-nil, an active region automatically becomes the window selection. + +Function in `interprogram-highlight-function' if any is +used to propagate the active region to the window system. +" :type 'boolean :group 'killing - :version "23.1") + :version "23.1" + :risky t + ;; make sure to deactivate idle timer on disable, in case there's + ;; a region active during the customize operation + :set (lambda (opt val) + (setq select-active-regions val) + (setq select-active-regions-last-region nil) + (if val + (progn + (cancel-function-timers 'maybe-select-for-select-active-regions) + (run-with-idle-timer 0 t + 'maybe-select-for-select-active-regions)) + (cancel-function-timers 'maybe-select-for-select-active-regions)))) + +(defun maybe-select-for-select-active-regions () + "Implements `select-active-regions'. Called by an idle timer +active when region is active and `set-mark'" + (and select-active-regions + (region-active-p) + (let ((maybe-sel-current-region-text + (buffer-substring (region-beginning) (region-end)))) + (when (or (null select-active-regions-last-region) + (not (string= select-active-regions-last-region + maybe-sel-current-region-text))) + (setq select-active-regions-last-region + maybe-sel-current-region-text) + (if (or (null maybe-sel-current-region-text) + (string= "" maybe-sel-current-region-text)) + ;; don't propagate if this region is empty, but this + ;; region being empty means future nonempty regions + ;; need repropagation + (setq select-active-regions-last-region nil) + (and interprogram-highlight-function + (funcall interprogram-highlight-function + maybe-sel-current-region-text))))))) + (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. +mark position to be lost. If `select-active-regions' is set, +install an idle timer to monitor the active region. 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'. Novice Emacs Lisp programmers often try to use the mark for the wrong purposes. The mark saves a location for the user's convenience. Most editing commands should not alter the mark. To remember a location for internal use in the Lisp program, 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 select-active-regions + (cancel-function-timers 'maybe-select-for-select-active-regions) + (run-with-idle-timer 0 t + 'maybe-select-for-select-active-regions) + ;;force immediate repropagate if mark is reset + (setq select-active-regions-last-region nil) + (maybe-select-for-select-active-regions)) (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.326 diff -U 8 -d -r1.326 mouse.el --- lisp/mouse.el 8 Jan 2008 05:12:50 -0000 1.326 +++ lisp/mouse.el 7 Feb 2008 03:43:43 -0000 @@ -920,16 +920,21 @@ (move-overlay ol (car range) (nth 1 range)))) (defun mouse-drag-track (start-event &optional do-mouse-drag-region-post-process) "Track mouse drags by highlighting area between point and cursor. The region will be defined with mark and point, and the overlay will be deleted after return. DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by mouse-drag-region." + ;; this function defines a new region, so deactivate mark before first + ;; moving point, to avoid briefly resizing the previous active region + ;; if any. Such a brief resize can produce poor behaviour when + ;; select-active-regions is enabled. + (deactivate-mark) (mouse-minibuffer-check start-event) (setq mouse-selection-click-count-buffer (current-buffer)) (let* ((original-window (selected-window)) ;; We've recorded what we needed from the current buffer and ;; window, now let's jump to the place of the event, where things ;; are happening. (_ (mouse-set-point start-event)) (echo-keystrokes 0) @@ -966,17 +971,17 @@ (if (< (point) start-point) (goto-char start-point)) (setq start-point (point)) (if remap-double-click ;; Don't expand mouse overlay in links (setq click-count 0)) (mouse-move-drag-overlay mouse-drag-overlay start-point start-point click-count) (overlay-put mouse-drag-overlay 'window start-window) - (deactivate-mark) + ;; (deactivate-mark) (let (event end end-point last-end-point) (track-mouse (while (progn (setq event (read-event)) (or (mouse-movement-p event) (memq (car-safe event) '(switch-frame select-window)))) (if (memq (car-safe event) '(switch-frame select-window)) nil @@ -1351,30 +1356,49 @@ (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-at-click-source :yank + "Source of yanked text in `mouse-yank-at-click' + +Yank: Do a full emacs kill-ring yank. Such a yank uses the emacs kill +ring and `interprogram-paste-function'. + +LightIns: Do an X11-style 'highlight/middlebutton' lightweight insert +by calling `interprogram-lightins-function', without referencing or +affecting the kill ring." + :type '(choice (const :tag "LightIns" :lightins) + (const :tag "Yank" :yank)) + :group 'mouse) + (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. + "Insert text from `mouse-yank-at-click-source' at the position clicked on. + +The source is either the kill-ring/clipboard or an X11-style interprogram +highlight. 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)) + (cond ((eq mouse-yank-at-click-source :lightins) + (and interprogram-lightins-function + (insert (funcall interprogram-lightins-function)))) + (t + (setq this-command 'yank) + (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. @@ -1431,79 +1455,128 @@ ;; that came from deleting one character. (while (and tail (not (stringp (car (car tail))))) (setq tail (cdr tail))) ;; Replace it with an entry for the entire deleted text. (and tail (setcar tail (cons (car kill-ring) (min beg end)))))) (undo-boundary)) +(defcustom mouse-save-then-kill-copy-region t + "Says how many clicks needed for mouse-save-then-kill to save then kill. + +Never: only adjust active region, never kill. +Single: save on single click, kill on second click +Double: adjust active region on first click, save +on second, kill on third" + +:type '(choice (const :tag "Never" nil) + (const :tag "Single" t) + (const :tag "Double" :double)) +:group 'mouse +:version "23.1") + (defun mouse-save-then-kill (click) - "Save text to point in kill ring; the second time, kill the text. + "Depending on click count, adjust region, save to kill ring, or kill + +Behaviour customized by `mouse-save-then-kill-copy-region'. If that +is nil, clicking merely adjusts the region. If :double, single +clicking adjusts the region, double clicking saves text to kill +ring, triple clicking kills the text. If nil, single clicking saves +text to kill ring, double clicking kills. + If the text between point and the mouse is the same as what's at the front of the kill ring, this deletes the text. Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], which prepares for a second click to delete the text. If you have selected words or lines, this command extends the selection through the word or line clicked on. If you do this again in a different position, it extends the selection again. -If you do this twice in the same position, the selection is killed." +" (interactive "e") (let ((before-scroll (with-current-buffer (window-buffer (posn-window (event-start click))) point-before-scroll))) (mouse-minibuffer-check click) (let ((click-posn (posn-point (event-start click))) ;; Don't let a subsequent kill command append to this one: ;; prevent setting this-command to kill-region. (this-command this-command)) (if (and (with-current-buffer (window-buffer (posn-window (event-start click))) (and (mark t) (> (mod mouse-selection-click-count 3) 0) ;; Don't be fooled by a recent click in some other buffer. (eq mouse-selection-click-count-buffer (current-buffer))))) + ;; moving by words/lines (if (not (and (eq last-command 'mouse-save-then-kill) (equal click-posn (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) ;; Find both ends of the object selected by this click. (let* ((range (mouse-start-end click-posn click-posn mouse-selection-click-count))) ;; Move whichever end is closer to the click. ;; That's what xterm does, and it seems reasonable. (if (< (abs (- click-posn (mark t))) (abs (- click-posn (point)))) (set-mark (car range)) (goto-char (nth 1 range))) - ;; We have already put the old region in the kill ring. - ;; Replace it with the extended region. - ;; (It would be annoying to make a separate entry.) - (kill-new (buffer-substring (point) (mark t)) t) + + (cond ((eq mouse-save-then-kill-copy-region t) ; save on first click + ;; We have already put the old region in the kill ring. + ;; Replace it with the extended region. + ;; (It would be annoying to make a separate entry.) + (kill-new (buffer-substring (point) (mark t)) t) + ;; Arrange for a repeated mouse-3 to kill this region. + (setq mouse-save-then-kill-posn + (list (car kill-ring) (point) click-posn))) + ((eq mouse-save-then-kill-copy-region :double) ; no save on first click + ;; no save on first click, but need to know region from first + ;; nil for saved kill ring top used to indicate limbo between second and third clicks + (setq mouse-save-then-kill-posn + (list nil (point) click-posn)))) (mouse-set-region-1) - ;; Arrange for a repeated mouse-3 to kill this region. - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn)) (mouse-show-mark)) - ;; If we click this button again without moving it, - ;; that time kill. - (mouse-save-then-kill-delete-region (mark) (point)) - (setq mouse-selection-click-count 0) - (setq mouse-save-then-kill-posn nil)) - (if (and (eq last-command 'mouse-save-then-kill) + (cond ((eq mouse-save-then-kill-copy-region t) ; kill on second click + ;; If we click this button again without moving it, + ;; that time kill. + (mouse-save-then-kill-delete-region (mark) (point)) + (setq mouse-selection-click-count 0) + (setq mouse-save-then-kill-posn nil)) + ((eq mouse-save-then-kill-copy-region :double) ;save on second/kill on third + (if (car-safe mouse-save-then-kill-posn) ; kill on third + (progn + (mouse-save-then-kill-delete-region (mark) (point)) + (setq mouse-selection-click-count 0) + (setq mouse-save-then-kill-posn nil)) + (progn ; save on second + (kill-new (buffer-substring (point) (mark t)) t) + (setq mouse-save-then-kill-posn + (list (car kill-ring) (point) click-posn))))))) + ;; moving by chars + (if (and (eq last-command 'mouse-save-then-kill) mouse-save-then-kill-posn - (eq (car mouse-save-then-kill-posn) (car kill-ring)) - (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) - ;; If this is the second time we've called - ;; mouse-save-then-kill, delete the text from the buffer. - (progn - (mouse-save-then-kill-delete-region (point) (mark)) - ;; After we kill, another click counts as "the first time". - (setq mouse-save-then-kill-posn nil)) + (equal (cdr-safe mouse-save-then-kill-posn) (list (point) click-posn))) + (cond ((eq mouse-save-then-kill-copy-region t) ; kill on second click + ;; If this is the second time we've called + ;; mouse-save-then-kill, delete the text from the buffer. + (mouse-save-then-kill-delete-region (point) (mark)) + ;; After we kill, another click counts as "the first time". + (setq mouse-save-then-kill-posn nil)) + ((eq mouse-save-then-kill-copy-region :double) ; save on second / kill on third + (if (car-safe mouse-save-then-kill-posn) ; kill on third + (progn + (mouse-save-then-kill-delete-region (point) (mark)) + (setq mouse-save-then-kill-posn nil)) + (progn ; save on second + (kill-new (buffer-substring (point) (mark t)) t) + (setq mouse-save-then-kill-posn + (list (car kill-ring) (point) click-posn)))))) ;; This is not a repetition. ;; We are adjusting an old selection or creating a new one. (if (or (and (eq last-command 'mouse-save-then-kill) mouse-save-then-kill-posn) (and mark-active transient-mark-mode) (and (memq last-command '(mouse-drag-region mouse-set-region)) (or mark-even-if-inactive @@ -1515,27 +1588,36 @@ (if (numberp new) (progn ;; Move whichever end of the region is closer to the click. ;; That is what xterm does, and it seems reasonable. (if (<= (abs (- new (point))) (abs (- new (mark t)))) (goto-char new) (set-mark new)) (setq deactivate-mark nil))) - (kill-new (buffer-substring (point) (mark t)) t)) + (and (eq mouse-save-then-kill-copy-region t) ; save on first click + (kill-new (buffer-substring (point) (mark t)) t))) ;; Set the mark where point is, then move where clicked. (mouse-set-mark-fast click) (if before-scroll (goto-char before-scroll)) (exchange-point-and-mark) ;Why??? --Stef - (kill-new (buffer-substring (point) (mark t)))) - (mouse-show-mark) + (and (eq mouse-save-then-kill-copy-region t) ; save on first click + (kill-new (buffer-substring (point) (mark t))))) + (cond ((eq mouse-save-then-kill-copy-region t) ; save on first click + (setq mouse-save-then-kill-posn + (list (car kill-ring) (point) click-posn))) + ((eq mouse-save-then-kill-copy-region :double) ; no save on first click + ;; no save on first click, but need to know region from first + ;; nil for saved kill ring top used to indicate limbo between + ;;second and third clicks + (setq mouse-save-then-kill-posn + (list nil (point) click-posn)))) (mouse-set-region-1) - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn))))))) + (mouse-show-mark)))))) (global-set-key [M-mouse-1] 'mouse-start-secondary) (global-set-key [M-drag-mouse-1] 'mouse-set-secondary) (global-set-key [M-down-mouse-1] 'mouse-drag-secondary) (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill) (global-set-key [M-mouse-2] 'mouse-yank-secondary) (defconst mouse-secondary-overlay Index: lisp/term/x-win.el =================================================================== RCS file: /sources/emacs/emacs/lisp/term/x-win.el,v retrieving revision 1.222 diff -U 8 -d -r1.222 x-win.el --- lisp/term/x-win.el 1 Feb 2008 16:01:25 -0000 1.222 +++ lisp/term/x-win.el 7 Feb 2008 03:43:45 -0000 @@ -2135,60 +2135,180 @@ (defvar x-last-selected-text-cut nil "The value of the X cut buffer last time we selected or pasted text. The actual text stored in the X cut buffer is what encoded from this value.") (defvar x-last-selected-text-cut-encoded nil "The value of the X cut buffer last time we selected or pasted text. 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-last-selected-return-multiple-list nil + "The last returned list from x-cut-buffer-or-selection-value when +x-cut-buffer-or-selection-value-return-multiple is on.") (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) +"Which interprogram-cut etc. functions should use the X11 CLIPBOARD selection. + +nil : none +t : all +Or choose one or more of: +:cut : Cut (and Copy) via `x-select-text' + \(X11's `interprogram-cut-function') +:paste : Paste via `x-cut-buffer-or-selection-value' + \(X11's `interprogram-paste-function') +:highlight : Highlight via `x-select-text-for-highlight' + \(X11's `interprogram-highlight-function') +:lightins : LightIns via `x-cut-buffer-or-selection-value-for-lightins' + \(X11's `interprogram-lightins-function') + +interprogram cut and paste are associated with kill ring operations in emacs. +interprogram highlight and lightins are independent of the kill ring +and associated with `set-active-region' and `mouse-yank-at-click'" + +:type '(choice (const :tag "None" nil) + (const :tag "All" t) + (set :tag "Choose" (const :tag "Cut/Copy" :cut) + (const :tag "Paste" :paste) + (const :tag "Highlight" :highlight) + (const :tag "LightIns" :lightins))) +:group 'killing) (defcustom x-select-enable-primary t - "Non-nil means cutting and pasting uses the primary selection." - :type 'boolean - :group 'killing) +"Which interprogram-cut etc. functions should use the X11 PRIMARY selection. + +nil : none +t : all +Or choose one or more of: +:cut : Cut (and Copy) via `x-select-text' + \(X11's `interprogram-cut-function') +:paste : Paste via `x-cut-buffer-or-selection-value' + \(X11's `interprogram-paste-function') +:highlight : Highlight via `x-select-text-for-highlight' + \(X11's `interprogram-highlight-function') +:lightins : LightIns via `x-cut-buffer-or-selection-value-for-lightins' + \(X11's `interprogram-lightins-function') + +interprogram cut and paste are associated with kill ring operations in emacs. +interprogram highlight and lightins are independent of the kill ring +and associated with `set-active-region' and `mouse-yank-at-click'" + +:type '(choice (const :tag "None" nil) + (const :tag "All" t) + (set :tag "Choose" (const :tag "Cut/Copy" :cut) + (const :tag "Paste" :paste) + (const :tag "Highlight" :highlight) + (const :tag "LightIns" :lightins))) +:group 'killing) + + +(defcustom x-select-enable-cutbuffer t + "Which interprogram-cut etc. functions should use X11 legacy Cut Buffer 0. + +In X, cut buffers have long been superseded by clipboard and primary +selections. However, some old X programs use them. If you +need to exchange data between emacs and such programs via +X cut buffers, you may want to set this to a non-nil value +\(currently defaults to t to preserve historic emacs behaviour) + +nil : none +t : all +Or choose one or more of: +:cut : Cut (and Copy) via `x-select-text' + \(X11's `interprogram-cut-function') +:paste : Paste via `x-cut-buffer-or-selection-value' + \(X11's `interprogram-paste-function') +:highlight : Highlight via `x-select-text-for-highlight' + \(X11's `interprogram-highlight-function') +:lightins : LightIns via `x-cut-buffer-or-selection-value-for-lightins' + \(X11's `interprogram-lightins-function') + + +interprogram cut and paste are associated with kill ring operations in emacs. +interprogram highlight and lightins are independent of the kill ring +and associated with `set-active-region' and `mouse-yank-at-click'" + +:type '(choice (const :tag "None" nil) + (const :tag "All" t) + (set :tag "Choose" (const :tag "Cut/Copy" :cut) + (const :tag "Paste" :paste) + (const :tag "Highlight" :highlight) + (const :tag "LightIns" :lightins))) +:group 'killing +:version "23.1") + + +(defun x-select-text-for-op (op text &optional push) + "Make TEXT, a string, the primary and/or clipboard X selection. + +This function matches OP against `x-select-enable-primary' +and `x-select-enable-clipboard'. OP must be one of :cut +or :highlight, corresponding to use as an `interprogram-cut-function' +or `interprogram-highlight-function'. This function is +wrapped by `x-select-text' and `x-select-text-for-highlight' +for their use as the X11 implementations of `interprogram-cut-function' +and `interprogram-highlight-function'. + +Also may set the value of X cut buffer 0, for backward compatibility +with older X applications, matching OP against `x-select-enable-cutbuffer' -(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. gildea@stop.mail-abuse.org 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 (or (eq x-select-enable-cutbuffer t) + (member op x-select-enable-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 (or (eq x-select-enable-primary t) + (member op x-select-enable-primary)) (x-set-selection 'PRIMARY text) (setq x-last-selected-text-primary text)) - (when x-select-enable-clipboard + (when (or (eq x-select-enable-clipboard t) + (member op x-select-enable-clipboard)) (x-set-selection 'CLIPBOARD text) (setq x-last-selected-text-clipboard text)))) + +(defun x-select-text (text &optional push) + "Make TEXT, a string, the primary and/or clipboard X11 selection (for cut). + +Also may set the value of X cut buffer 0, for backward compatibility +with older X applications. + +This function is suitable as an `interprogram-cut-function'. +This function is implemented by calling `x-select-text-for-op' with OP :cut" + (x-select-text-for-op :cut text push)) + + +(defun x-select-text-for-highlight (text &optional push) + "Make TEXT, a string, the primary and/or clipboard X11 selection (for highlight). + +Also may set the value of X cut buffer 0, for backward compatibility +with older X applications. + +This function is suitable as an `interprogram-highlight-function'. +This function is implemented by calling `x-select-text-for-op' with OP `:highlight'" + (x-select-text-for-op :highlight text push)) + + (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' If the value is one of the above symbols, try only the specified type. @@ -2216,27 +2336,95 @@ (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, and the cut buffer. Treat empty strings + +(defcustom x-cut-buffer-or-selection-value-return-multiple nil +"If non-nil `x-cut-buffer-or-selection-value' returns multiple selections. +Order is determined by `x-cut-buffer-or-selection-value-return-order'" +:type 'boolean +:group 'killing +:version "23.1") + +(defcustom x-cut-buffer-or-selection-value-return-order :cpb +"Determines precedence for return from `x-cut-buffer-or-selection-value', +the X implementation of `interprogram-paste-function'. + +Note that a selection will only actually be returned +if the associated `x-select-enable-primary' +/`x-select-enable-clipboard'/ `x-select-enable-cutbuffer' +has :paste or t set. + +If `x-cut-buffer-or-selection-value-return-multiple' is nil, +this determines precedence for the single return." + +:type '(choice + (const :tag "Clipboard > Primary > CutBuffer" :cpb) + (const :tag "Primary > Clipboard > CutBuffer" :pcb)) + ;; more could be added, but I doubt are terribly useful + ;; - Cut Buffer 0 not exactly used much. + ;; '(const :tag "Clipboard > CutBuffer > Primary" :cbp) + ;; '(const :tag "Primary > CutBuffer > Clipboard" :pbc) + ;; '(const :tag "CutBuffer > Clipboard > Primary" :bcp) + ;; '(const :tag "CutBuffer > Primary > Clipboard" :bpc) +:group 'killing +:version "23.1") + +(defcustom x-cut-buffer-or-selection-value-for-lightins-return-order :cpb +"Determines precedence for return +from `x-cut-buffer-or-selection-value-for-lightins', +the X implementation of `interprogram-paste-function'. + +Note that a selection will only actually be returned +if the associated `x-select-enable-primary' +/`x-select-enable-clipboard'/ `x-select-enable-cutbuffer' +has :lightins or t set." + +:type '(choice + (const :tag "Clipboard > Primary > CutBuffer" :cpb) + (const :tag "Primary > Clipboard > CutBuffer" :pcb)) + ;; more could be added, but I doubt are terribly useful + ;; - Cut Buffer 0 not exactly used much. + ;; '(const :tag "Clipboard > CutBuffer > Primary" :cbp) + ;; '(const :tag "Primary > CutBuffer > Clipboard" :pbc) + ;; '(const :tag "CutBuffer > Clipboard > Primary" :bcp) + ;; '(const :tag "CutBuffer > Primary > Clipboard" :bpc) +:group 'killing +:version "23.1") + + +;; Return the value(s) of the current X selection(s). +;; Consult the selections, and the cut buffer. 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. (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 + + ;; Don't ever do individual newness checks when + ;; potentially returning multiple selections, + ;; in the multiple selection case, only comparing + ;; the previous entire return list produces + ;; reasonable behaviour. + (when x-cut-buffer-or-selection-value-return-multiple + (setq x-last-selected-text-primary nil + x-last-selected-text-clipboard nil + x-last-selected-text-cut nil + x-last-selected-text-cut-encoded nil)) + + (when (or (eq x-select-enable-clipboard t) + (member :paste x-select-enable-clipboard)) (setq clip-text (x-selection-value 'CLIPBOARD)) (if (string= clip-text "") (setq clip-text nil)) ;; 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 @@ -2245,17 +2433,18 @@ ((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 (or (eq x-select-enable-primary t) + (member :paste x-select-enable-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)) @@ -2263,74 +2452,130 @@ ((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)) + (when (or (eq x-select-enable-cutbuffer t) + (member :paste x-select-enable-cutbuffer)) + (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)))))) - ;; 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)) - ;; As we have done one selection, clear this now. - (setq next-selection-coding-system nil) + ;; return one or more of the found selections. + (if x-cut-buffer-or-selection-value-return-multiple + (let ((maybe-x-sel-val-return-list + (cond ((eq :cpb x-cut-buffer-or-selection-value-return-order) + (delete-dups (delq nil (list clip-text primary-text cut-text)))) + ((eq :pcb x-cut-buffer-or-selection-value-return-order) + (delete-dups (delq nil (list primary-text clip-text cut-text))))))) + (if (or (null x-last-selected-return-multiple-list) + ;; if the return list would be same as (equal) to or + ;; equal to a head-pinned sublist of the last return, + ;; do not rereturn it. + ;; this keeps kill-ring interaction of multiple selections + ;; ... not great, but less sucky than endless duplicates. + ;; could have used clearer cl, but wanted to avoid dep. + (not (let ((a maybe-x-sel-val-return-list) + (b x-last-selected-return-multiple-list) + (sub t)) + (while (and sub + (not (null a))) + (setq sub (and (equal (car a) (car b)) + (not (null b))) + a (cdr a) + b (cdr b))) + sub))) + (setq x-last-selected-return-multiple-list + maybe-x-sel-val-return-list) + nil)) + (cond ((eq :cpb x-cut-buffer-or-selection-value-return-order) + (or clip-text primary-text cut-text)) + ((eq :pcb x-cut-buffer-or-selection-value-return-order) + (or primary-text clip-text cut-text))))))) - ;; 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 - ;; 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 or two of them (say - ;; just the cut-buffer). 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. - ;; This code is still a big improvement because now the user can - ;; futz with the current selection and get emacs to pay attention - ;; to the cut buffer again (previously as soon as clipboard or - ;; primary had been set the cut buffer would essentially never be - ;; checked again). - (or clip-text primary-text cut-text) - ))) + +;; Return the value of the current X selection for a "lightweight insertion" +;; that is not intended to interact with the kill ring. No, really. +;; Consult the selection, and the cut buffer. Treat empty strings +;; as if they were unset. +;; If this function is called twice and finds the same text, +;; unlike x-cut-buffer-or-selection-value, it should return the same text. +;; See interprogram-lightins-function docstring... +(defun x-cut-buffer-or-selection-value-for-lightins () + ;; 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 (or (eq x-select-enable-clipboard t) + (member :lightins x-select-enable-clipboard)) + (setq clip-text (x-selection-value 'CLIPBOARD)) + (if (string= clip-text "") (setq clip-text nil))) + + (when (or (eq x-select-enable-primary t) + (member :lightins x-select-enable-primary)) + (setq primary-text (x-selection-value 'PRIMARY))) + + (when (or (eq x-select-enable-cutbuffer t) + (member :lightins x-select-enable-cutbuffer)) + (setq cut-text (x-get-cut-buffer 0)) + ;; try to decode cut buffer. + (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 "")) + nil) + (t ;; 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)) + + (cond ((eq :cpb x-cut-buffer-or-selection-value-for-lightins-return-order) + (or clip-text primary-text cut-text)) + ((eq :pcb x-cut-buffer-or-selection-value-for-lightins-return-order) + (or primary-text clip-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) +(setq interprogram-highlight-function 'x-select-text-for-highlight) +(setq interprogram-lightins-function 'x-cut-buffer-or-selection-value-for-lightins) (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))