1. xemacs
  2. xwem


xwem / lisp / xwem-selections.el

;;; xwem-selections.el --- Support for X selections.

;; Copyright (C) 2004,2005 by XWEM Org.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Wed May  5 17:06:41 MSD 2004
;; Keywords: xwem
;; X-CVS: $Id$

;; This file is part of XWEM.

;; XWEM 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.

;; XWEM is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:


;;; Code:
(require 'xwem-load)
(require 'xwem-help)

(defgroup xwem-selections nil
  "Group to customize `xwem-selections'."
  :prefix "xwem-selections-"
  :group 'xwem)

(defcustom xwem-selections-maximum 20
  "Maximum number of saved selections."
  :type 'number
  :group 'xwem-selections)

(defcustom xwem-selections-no-remove t
  "*Non-nil mean, reverse meaning of prefix arg for `xwem-paste-cutbuffer' command.
Without prefix arg, keep currently pasted cutbuffer.
With prefix arg, remove it."
  :type 'boolean
  :group 'xwem-selections)

;;; Internal variables

(defvar xwem-selections nil
  "Ring of saved selections.
Actually alist")

(defvar xwem-selection-xwin nil
  "X-Win used to operate on selections.")

(defun xwem-init-selections ()
  "Initialize selections mechanism."
  (setq xwem-selection-xwin
        (XCreateWindow (xwem-dpy) (xwem-rootwin)
                       0 0 1 1 0 nil nil nil
                       (make-X-Attr :override-redirect t
                                    :event-mask (Xmask-or XM-StructureNotify))))

  (X-Win-EventHandler-add-new xwem-selection-xwin 'xwem-selection-get nil
                              (list X-SelectionNotify))

(defun xwem-selection-req (sel &optional targ prop)
  "Issue XConvertSelection."
  (unless targ
    (setq targ XA-string))

  (XConvertSelection (xwem-dpy)
                     (if (X-Atom-p sel) sel (XInternAtom (xwem-dpy) sel t))
                     (if (X-Atom-p targ) targ (XInternAtom (xwem-dpy) targ t))
                      (xwem-dpy) (or prop "XWEM_SELECTION_PROPERTY") t)

(defun xwem-selection-get (xdpy xwin xev)
  "On display XDPY and window XWIN process SelectionNotify event XEV."
  (xwem-debug 'xwem-misc "here prop=%d"
              '(X-Atom-id (X-Event-xselection-property xev)))
  (let (target prov)
    (if (not (= (X-Atom-id (X-Event-xselection-property xev)) X-None))
          (if (X-Atom-equal (X-Event-xselection-target xev)
                            (XInternAtom xdpy "XA_TARGETS" t))
              (setq target XA-atom)
            (setq target (X-Event-xselection-target xev)))

          (setq prov (XGetWindowProperty
                      xdpy (X-Event-xselection-requestor xev)
                      (X-Event-xselection-property xev) nil nil nil target))

          (xwem-debug 'xwem-misc "Got prov=%S, prop=%S target=%S"
                      'prov '(X-Atom-id (X-Event-xselection-property xev))
                      '(X-Atom-id target)))

;;;###autoload(autoload 'xwem-help-cutbuffers "xwem-selections" "Display help about cutbuffers." t)
(define-xwem-command xwem-help-cutbuffers ()
  "Show help buffer about cutbuffers."

  (xwem-help-display "cutbuffers"
    (insert "X cutbuffers:\n\n")
    (insert "NUMBER   VALUE\n")
    (insert "------   -----\n")
    (insert (format "%-9s%S\n" 'PRIMARY (get-selection)))
    (mapc #'(lambda (n)
              (let ((cbval (x-get-cutbuffer n)))
                (when cbval
                  (insert (format "%-9d%S\n" n cbval)))))
          '(0 1 2 3 4 5 6 7))

    (insert "\n")

    (insert "XWEM selections:\n\n")
    (insert "NUMBER   VALUE\n")
    (insert "------   -----\n")
    (let ((nsel 0))
      (mapc #'(lambda (s)
                (insert (format "%-9d%S\n" nsel s))
                (incf nsel))

;;;###autoload(autoload 'xwem-copy-cutbuffer "xwem-selections" "Copy CUTBUFFER0 to `xwem-selections'." t)
(define-xwem-command xwem-copy-cutbuffer (&optional which-one)
  "Copy WHICH-ONE cutbuffer to `xwem-selections'.
However if Emacs region activated, region is copied instead of
  (xwem-interactive "p")

  (if (region-active-p)

    (decf which-one)
    (let ((cb0 (condition-case nil
                 (t (x-get-cutbuffer which-one)))))
      (if (not cb0)
	  (xwem-message 'note "No active selection")
	(push cb0 xwem-selections)
	(xwem-message 'info "Copying %S" cb0)))))

;;;###autoload(autoload 'xwem-paste-cutbuffer "xwem-selections" "Paste CUTBUFFER0 to `xwem-selections'." t)
(define-xwem-command xwem-paste-cutbuffer (&optional no-remove)
  "Paste's most recent cutbuffer from `xwem-selections' to selected client.
cutbuffer is removed from `xwem-selections', unless NO-REMOVE is non-nil.
However if `xwem-selections-no-remove' is non-nil, NO-REMOVE have
opposite meaning."
  (xwem-interactive "_P")

  (let ((sidx (or (and (numberp no-remove)
    (when (> sidx (1- (length xwem-selections)))
      (error 'xwem-error (format "No %d selection" sidx)))

    (setq sel (nth sidx xwem-selections))
    (mapc 'xwem-unread-command-event sel)
    ;; Remove SEL from `xwem-selections'?
    (setq no-remove (and no-remove (listp no-remove)))
    (unless (or (and xwem-selections-no-remove
                     (not no-remove))
                (and (not xwem-selections-no-remove)
      (setq xwem-selections (delq sel xwem-selections)))))

;;;###autoload(autoload 'xwem-copy-region-as-cutbuffer "xwem-selections" "Copy region to `xwem-selections'." t)
(define-xwem-command xwem-copy-region-as-cutbuffer ()
  "Copy selected region to `xwem-selections' as ordinary cutbuffer."

  (unless (region-active-p)
    (error 'xwem-error "No active region"))
  (let ((rr (buffer-substring (region-beginning) (region-end))))
    (push rr xwem-selections)
    (xwem-message 'info "Copying: %S" rr)))

(provide 'xwem-selections)

;;; xwem-selections.el ends here