cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-selections.el

   1 ;;; xwem-selections.el --- Support for X selections.
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Wed May  5 17:06:41 MSD 2004
   7 ;; Keywords: xwem
   8 ;; X-CVS: $Id: xwem-selections.el,v 1.5 2005-04-04 19:54:15 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;;
  32
  33 ;;; Code:
  34 \f
  35 (require 'xwem-load)
  36 (require 'xwem-help)
  37
  38 (defgroup xwem-selections nil
  39   "Group to customize `xwem-selections'."
  40   :prefix "xwem-selections-"
  41   :group 'xwem)
  42
  43 (defcustom xwem-selections-maximum 20
  44   "Maximum number of saved selections."
  45   :type 'number
  46   :group 'xwem-selections)
  47
  48 (defcustom xwem-selections-no-remove t
  49   "*Non-nil mean, reverse meaning of prefix arg for `xwem-paste-cutbuffer' command.
  50 Without prefix arg, keep currently pasted cutbuffer.
  51 With prefix arg, remove it."
  52   :type 'boolean
  53   :group 'xwem-selections)
  54
  55 ;;; Internal variables
  56
  57 \f
  58 (defvar xwem-selections nil
  59   "Ring of saved selections.
  60 Actually alist")
  61
  62 (defvar xwem-selection-xwin nil
  63   "X-Win used to operate on selections.")
  64
  65 (defun xwem-init-selections ()
  66   "Initialize selections mechanism."
  67   (setq xwem-selection-xwin
  68         (XCreateWindow (xwem-dpy) (xwem-rootwin)
  69                        0 0 1 1 0 nil nil nil
  70                        (make-X-Attr :override-redirect t
  71                                     :event-mask (Xmask-or XM-StructureNotify))))
  72
  73   (X-Win-EventHandler-add-new xwem-selection-xwin 'xwem-selection-get nil
  74                               (list X-SelectionNotify))
  75   )
  76
  77 (defun xwem-selection-req (sel &optional targ prop)
  78   "Issue XConvertSelection."
  79   (unless targ
  80     (setq targ XA-string))
  81
  82   (XConvertSelection (xwem-dpy)
  83                      (if (X-Atom-p sel) sel (XInternAtom (xwem-dpy) sel t))
  84                      (if (X-Atom-p targ) targ (XInternAtom (xwem-dpy) targ t))
  85                      (XInternAtom
  86                       (xwem-dpy) (or prop "XWEM_SELECTION_PROPERTY") t)
  87                      xwem-selection-xwin)
  88   )
  89
  90 (defun xwem-selection-get (xdpy xwin xev)
  91   "On display XDPY and window XWIN process SelectionNotify event XEV."
  92   (xwem-debug 'xwem-misc "here prop=%d"
  93               '(X-Atom-id (X-Event-xselection-property xev)))
  94   (let (target prov)
  95     (if (not (= (X-Atom-id (X-Event-xselection-property xev)) X-None))
  96         (progn
  97           (if (X-Atom-equal (X-Event-xselection-target xev)
  98                             (XInternAtom xdpy "XA_TARGETS" t))
  99               (setq target XA-atom)
 100             (setq target (X-Event-xselection-target xev)))
 101
 102           (setq prov (XGetWindowProperty
 103                       xdpy (X-Event-xselection-requestor xev)
 104                       (X-Event-xselection-property xev) nil nil nil target))
 105
 106           (xwem-debug 'xwem-misc "Got prov=%S, prop=%S target=%S"
 107                       'prov '(X-Atom-id (X-Event-xselection-property xev))
 108                       '(X-Atom-id target)))
 109       )))
 110
 111 ;;;###autoload(autoload 'xwem-help-cutbuffers "xwem-selections" "Display help about cutbuffers." t)
 112 (define-xwem-command xwem-help-cutbuffers ()
 113   "Show help buffer about cutbuffers."
 114   (xwem-interactive)
 115
 116   (xwem-help-display "cutbuffers"
 117     (insert "X cutbuffers:\n\n")
 118     (insert "NUMBER   VALUE\n")
 119     (insert "------   -----\n")
 120     (insert (format "%-9s%S\n" 'PRIMARY (get-selection)))
 121     (mapc #'(lambda (n)
 122               (let ((cbval (x-get-cutbuffer n)))
 123                 (when cbval
 124                   (insert (format "%-9d%S\n" n cbval)))))
 125           '(0 1 2 3 4 5 6 7))
 126
 127     (insert "\n")
 128
 129     (insert "XWEM selections:\n\n")
 130     (insert "NUMBER   VALUE\n")
 131     (insert "------   -----\n")
 132     (let ((nsel 0))
 133       (mapc #'(lambda (s)
 134                 (insert (format "%-9d%S\n" nsel s))
 135                 (incf nsel))
 136             xwem-selections))))
 137
 138 ;;;###autoload(autoload 'xwem-copy-cutbuffer "xwem-selections" "Copy CUTBUFFER0 to `xwem-selections'." t)
 139 (define-xwem-command xwem-copy-cutbuffer (&optional which-one)
 140   "Copy WHICH-ONE cutbuffer to `xwem-selections'.
 141 However if Emacs region activated, region is copied instead of
 142 cutbuffer."
 143   (xwem-interactive "p")
 144
 145   (if (region-active-p)
 146       (xwem-copy-region-as-cutbuffer)
 147
 148     (decf which-one)
 149     (let ((cb0 (condition-case nil
 150                    (get-selection)
 151                  (t (x-get-cutbuffer which-one)))))
 152       (if (not cb0)
 153           (xwem-message 'note "No active selection")
 154         (push cb0 xwem-selections)
 155         (xwem-message 'info "Copying %S" cb0)))))
 156
 157 ;;;###autoload(autoload 'xwem-paste-cutbuffer "xwem-selections" "Paste CUTBUFFER0 to `xwem-selections'." t)
 158 (define-xwem-command xwem-paste-cutbuffer (&optional no-remove)
 159   "Paste's most recent cutbuffer from `xwem-selections' to selected client.
 160 cutbuffer is removed from `xwem-selections', unless NO-REMOVE is non-nil.
 161 However if `xwem-selections-no-remove' is non-nil, NO-REMOVE have
 162 opposite meaning."
 163   (xwem-interactive "_P")
 164
 165   (let ((sidx (or (and (numberp no-remove)
 166                        no-remove)
 167                   0))
 168         sel)
 169     (when (> sidx (1- (length xwem-selections)))
 170       (error 'xwem-error (format "No %d selection" sidx)))
 171
 172     (setq sel (nth sidx xwem-selections))
 173     (xwem-kbd-force-mods-release)
 174     (mapc 'xwem-unread-command-event sel)
 175
 176     ;; Remove SEL from `xwem-selections'?
 177     (setq no-remove (and no-remove (listp no-remove)))
 178     (unless (or (and xwem-selections-no-remove
 179                      (not no-remove))
 180                 (and (not xwem-selections-no-remove)
 181                      no-remove))
 182       (setq xwem-selections (delq sel xwem-selections)))))
 183
 184 ;;;###autoload(autoload 'xwem-copy-region-as-cutbuffer "xwem-selections" "Copy region to `xwem-selections'." t)
 185 (define-xwem-command xwem-copy-region-as-cutbuffer ()
 186   "Copy selected region to `xwem-selections' as ordinary cutbuffer."
 187   (xwem-interactive)
 188
 189   (unless (region-active-p)
 190     (error 'xwem-error "No active region"))
 191
 192   (let ((rr (buffer-substring (region-beginning) (region-end))))
 193     (push rr xwem-selections)
 194     (xwem-message 'info "Copying: %S" rr)))
 195
 196 \f
 197 (provide 'xwem-selections)
 198
 199 ;;; xwem-selections.el ends here