[elpa] master 1192a1b: * xclip/xclip.el: Use gui-backend-*-selection in Emacs≥25

[Stefan Monnier]

branch: master
commit 1192a1bf4d0e82246e56d5fe026af7ff7acfd788
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * xclip/xclip.el: Use gui-backend-*-selection in Emacs≥25
    
    (xclip-set-selection) <pbcopy>:
    Don't set the clipboard when primary is requested.
    (xclip-get-selection): New function extracted from xclip-selection-value.
    (turn-on-xclip): Rename to xclip--setup.
    (xclip-mode): Don't use xclip--setup in Emacs≥25.
    Disable the mode is xclip-program is not found.
    (xclip--if-macro-fboundp): New macro.
    (gui-backend-get-selection, gui-backend-set-selection): New methods.
---
 packages/xclip/xclip.el | 125 +++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 96 insertions(+), 29 deletions(-)

diff --git a/packages/xclip/xclip.el b/packages/xclip/xclip.el
index fd1a748..992fd9b 100644
--- a/packages/xclip/xclip.el
+++ b/packages/xclip/xclip.el
@@ -1,11 +1,11 @@
 ;;; xclip.el --- use xclip to copy&paste             -*- lexical-binding: t; 
-*-
 
-;; Copyright (C) 2007, 2012, 2013  Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2012, 2013, 2017  Free Software Foundation, Inc.
 
 ;; Author: Leo Liu <address@hidden>
 ;; Keywords: convenience, tools
 ;; Created: 2007-12-30
-;; Version: 1.3
+;; Version: 1.4
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -22,8 +22,8 @@
 
 ;;; Commentary:
 
-;; This package allows emacs to copy to and paste from the X clipboard
-;; when running in xterm. It uses the external command-line tool xclip
+;; This package allows Emacs to copy to and paste from the X clipboard
+;; when running in xterm.  It uses the external command-line tool xclip
 ;; found on http://xclip.sourceforge.net.
 ;;
 ;; To use: (xclip-mode 1)
@@ -56,13 +56,15 @@ If non-nil `xclip-program' is ignored."
 (defvar xclip-last-selected-text-primary nil
   "The value of the PRIMARY X selection from xclip.")
 
+;;;; Core functions.
+
 (defun xclip-set-selection (type data)
   "TYPE is a symbol: primary, secondary and clipboard.
 
 See also `x-set-selection'."
   (let* ((process-connection-type nil)
          (proc (cond
-                (xclip-use-pbcopy&paste
+                ((and xclip-use-pbcopy&paste (memq type '(clipboard 
CLIPBOARD)))
                  (start-file-process "pbcopy" nil "pbcopy"))
                 ((getenv "DISPLAY")
                  (start-file-process "xclip" nil xclip-program
@@ -72,6 +74,33 @@ See also `x-set-selection'."
       (process-send-eof proc))
     data))
 
+(defun xclip-get-selection (type)
+  "TYPE is a symbol: primary, secondary and clipboard."
+  (with-output-to-string
+    (cond
+     ((and xclip-use-pbcopy&paste (memq type '(clipboard CLIPBOARD)))
+      (process-file "pbpaste" nil standard-output nil))
+     ((getenv "DISPLAY")
+      (process-file xclip-program nil standard-output nil
+                    "-o" "-selection" (symbol-name type))))))
+
+;;;###autoload
+(define-minor-mode xclip-mode
+  "Minor mode to use the `xclip' program to copy&paste."
+  :global t
+  (remove-hook 'terminal-init-xterm-hook #'xclip--setup)
+  (when xclip-mode
+    (unless (or xclip-use-pbcopy&paste
+               (executable-find xclip-program))
+      (setq xclip-mode nil)
+      (signal 'file-error (list "Searching for program"
+                               xclip-program "no such file")))
+    (when (< emacs-major-version 25)
+      ;; NOTE: See `tty-run-terminal-initialization' and term/README
+      (add-hook 'terminal-init-xterm-hook #'xclip--setup))))
+
+;;;; Glue code for Emacs < 25
+
 (defun xclip-select-text (text)
   "See `x-select-text'."
   (xclip-set-selection 'primary text)
@@ -83,13 +112,7 @@ See also `x-set-selection'."
 (defun xclip-selection-value ()
   "See `x-selection-value'."
   (let ((clip-text (when xclip-select-enable-clipboard
-                     (with-output-to-string
-                       (cond
-                        (xclip-use-pbcopy&paste
-                         (process-file "pbpaste" nil standard-output nil))
-                        ((getenv "DISPLAY")
-                         (process-file xclip-program nil standard-output nil
-                                       "-o" "-selection" "clipboard")))))))
+                     (xclip-get-selection 'CLIPBOARD))))
     (setq clip-text
           (cond                         ; Check clipboard selection.
            ((or (not clip-text) (string= clip-text ""))
@@ -121,23 +144,67 @@ See also `x-set-selection'."
                    (t (setq xclip-last-selected-text-primary primary-text))))
             primary-text)))))
 
-(defun turn-on-xclip ()
-  (setq interprogram-cut-function 'xclip-select-text)
-  (setq interprogram-paste-function 'xclip-selection-value))
-
-;;;###autoload
-(define-minor-mode xclip-mode
-  "Minor mode to use the `xclip' program to copy&paste."
-  :global t
-  (if xclip-mode
-      (progn
-        (or xclip-use-pbcopy&paste
-            (executable-find xclip-program)
-            (signal 'file-error (list "Searching for program"
-                                      xclip-program "no such file")))
-        ;; NOTE: See `tty-run-terminal-initialization' and term/README
-        (add-hook 'terminal-init-xterm-hook 'turn-on-xclip))
-    (remove-hook 'terminal-init-xterm-hook 'turn-on-xclip)))
+(defun xclip--setup ()
+  (setq interprogram-cut-function #'xclip-select-text)
+  (setq interprogram-paste-function #'xclip-selection-value))
+
+
+;;;; Glue code for Emacs ≥ 25
+
+(eval-when-compile
+  (defmacro xclip--if-macro-fboundp (name then &rest else)
+    ;; FIXME: copy&pasted from AUCTeX's tex.el.
+    "Execute THEN if macro NAME is bound and ELSE otherwise.
+Essentially,
+
+  (xclip--if-macro-fboundp name then else...)
+
+is equivalent to
+
+  (if (fboundp 'name) then else...)
+
+but takes care of byte-compilation issues where the byte-code for
+the latter could signal an error if it has been compiled with
+emacs 24.1 and is then later run by emacs 24.5."
+    (declare (indent 2) (debug (symbolp form &rest form)))
+    (if (fboundp name)           ;If macro exists at compile-time, just use it.
+        then
+      `(if (fboundp ',name)             ;Else, check if it exists at run-time.
+          (eval ',then)                ;If it does, then run the then code.
+         ,@else))))                     ;Otherwise, run the else code.
+
+(xclip--if-macro-fboundp cl-defmethod
+ (progn
+   ;; FIXME: implement the methods for gui-backend-selection-owner-p
+   ;; and gui-backend-selection-exists-p.  Not sure about pbcopy, but at least
+   ;; with xcopy, gui-backend-selection-owner-p should just require us
+   ;; to use "-silent" and keep track of the liveness of the subprocess.
+
+   (cl-defmethod gui-backend-get-selection (selection-symbol _target-type
+                                            &context (window-system nil))
+     (if (not xclip-mode)
+         (cl-call-next-method)
+       (xclip-get-selection selection-symbol)))
+
+   (cl-defmethod gui-backend-set-selection (selection-symbol value
+                                            &context (window-system nil))
+     (if (not xclip-mode)
+         (cl-call-next-method)
+       (xclip-set-selection selection-symbol value)
+       nil))
+
+   ;; BIG UGLY HACK!
+   ;; xterm.el has a defmethod to use some poorly supported escape sequences
+   ;; (code named OSC 52) for clipboard interaction, and enables it by default.
+   ;; Problem is, that its defmethod takes precedence over our defmethod,
+   ;; so we need to disable it in order to be called.
+   (cl-defmethod gui-backend-set-selection :extra "xclip-override"
+     (selection-symbol value &context (window-system nil)
+                       ((terminal-parameter nil 'xterm--set-selection) (eql 
t)))
+     ;; Disable this method which doesn't work anyway in 99% of the cases!
+     (setf (terminal-parameter nil 'xterm--set-selection) nil)
+     ;; Try again!
+     (gui-backend-set-selection selection-symbol value))))
 
 (provide 'xclip)
 ;;; xclip.el ends here