1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
|
;; Copyright (C) 2003-2008 Shawn Betts
;;
;; This file is part of stumpwm.
;;
;; stumpwm is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; stumpwm is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
;; Commentary:
;;
;; Handle the X selection.
;;
;; Code:
(in-package #:stumpwm)
(export '(get-x-selection
set-x-selection))
(defun export-selection ()
(let* ((screen (current-screen))
(selwin (screen-focus-window (current-screen)))
(root (screen-root screen)))
(xlib:set-selection-owner *display* :primary selwin)
(unless (xlib:window-equal (xlib:selection-owner *display* :primary) selwin)
(error "Can't set selection owner"))
;; also set the cut buffer for completeness
(xlib:change-property root :cut-buffer0 *x-selection* :string 8 :transform #'xlib:char->card8
:mode :replace)))
(defun set-x-selection (text)
"Set the X11 selection string to @var{string}."
(setf *x-selection* text)
(export-selection))
(defun send-selection (requestor property selection target time)
(dformat 1 "send-selection ~s ~s ~s ~s ~s~%" requestor property selection target time)
(cond
;; they're requesting what targets are available
((eq target :targets)
(xlib:change-property requestor property (list :targets :string) target 8 :mode :replace))
;; send them a string
((find target '(:string ))
(xlib:change-property requestor property *x-selection* :string 8 :mode :replace :transform #'xlib:char->card8))
;; we don't know how to handle anything else
(t
(setf property nil)))
(xlib:send-event requestor :selection-notify nil
:display *display*
:window requestor
:selection selection
:property property
:target target
:time time)
(xlib:display-finish-output *display*))
(defun get-x-selection (&optional timeout)
"Return the x selection no matter what client own it."
(labels ((wait-for-selection (&rest event-slots &key display event-key &allow-other-keys)
(declare (ignore display))
(when (eq event-key :selection-notify)
(destructuring-bind (&key window property &allow-other-keys) event-slots
(if property
(xlib:get-property window property :type :string :result-type 'string :transform #'xlib:card8->char :delete-p t)
"")))))
(if *x-selection*
*x-selection*
(progn
(xlib:convert-selection :primary :string (screen-input-window (current-screen)) :stumpwm-selection)
;; Note: this may spend longer than timeout in this loop but it will eventually return.
(let ((time (get-internal-real-time)))
(loop for ret = (xlib:process-event *display* :handler #'wait-for-selection :timeout timeout :discard-p nil)
when (or ret
(> (/ (- time (get-internal-real-time)) internal-time-units-per-second)
timeout))
;; make sure we return a string
return (or ret "")))))))
;;; Commands
(defcommand putsel (string) ((:rest "Text: "))
"Stuff the string @var{string} into the X selection."
(set-x-selection string))
;; FIXME: this function is basically useless atm.
(defcommand getsel () ()
"Echo the X selection."
(message "~a" (get-x-selection)))
(defcommand copy-last-message () ()
"Copy the last message displayed into the X selection"
(when (screen-last-msg (current-screen))
(set-x-selection (uncolorify (format nil "~{~a~^~%~}" (car (screen-last-msg (current-screen))))))))
|