Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 54fa1a5c2d12
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 20 ;; General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 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 23 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA. 25 ;; Boston, MA 02111-1307, USA.
26 26
27 ;;; Synched up with: Not in FSF 27 ;;; Synched up with: Not in FSF
28 28
29 ;;; Commentary: 29 ;;; Commentary:
30 30
31 ;; This file is dumped with XEmacs 31 ;; This file is dumped with XEmacs
32 32
33 ;;; Code: 33 ;;; Code:
34 34
35 (defvar selected-text-type 35 (defvar selected-text-type
36 (if (featurep 'mule) '(COMPOUND_TEXT STRING) 'STRING) 36 (if (featurep 'mule) '(COMPOUND_TEXT STRING) 'STRING)
38 Can be either a valid X selection data type, or a list of such types. 38 Can be either a valid X selection data type, or a list of such types.
39 COMPOUND_TEXT and STRING are the most commonly used data types. 39 COMPOUND_TEXT and STRING are the most commonly used data types.
40 If a list is provided, the types are tried in sequence until 40 If a list is provided, the types are tried in sequence until
41 there is a successful conversion.") 41 there is a successful conversion.")
42 42
43 (defvar selection-sets-clipboard nil 43 (defvar selection-sets-clipboard nil
44 "Controls the selection's relationship to the clipboard. 44 "Controls the selection's relationship to the clipboard.
45 When non-nil, any operation that sets the primary selection will also 45 When non-nil, any operation that sets the primary selection will also
46 set the clipboard.") 46 set the clipboard.")
47 47
48 (defun copy-primary-selection () 48 (defun copy-primary-selection ()
84 84
85 (defun get-selection-no-error (&optional type data-type) 85 (defun get-selection-no-error (&optional type data-type)
86 "Return the value of a window-system selection. 86 "Return the value of a window-system selection.
87 The argument TYPE (default `PRIMARY') says which selection, 87 The argument TYPE (default `PRIMARY') says which selection,
88 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) 88 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
89 says how to convert the data. Returns NIL if there is no selection" 89 says how to convert the data. Returns NIL if there is no selection."
90 (condition-case nil (get-selection type data-type) (t nil))) 90 (condition-case nil (get-selection type data-type) (t nil)))
91 91
92 (defun get-selection (&optional type data-type) 92 (defun get-selection (&optional type data-type)
93 "Return the value of a window-system selection. 93 "Return the value of a window-system selection.
94 The argument TYPE (default `PRIMARY') says which selection, 94 The argument TYPE (default `PRIMARY') says which selection,
621 ;; Cons'd integers get cleaned up a little. 621 ;; Cons'd integers get cleaned up a little.
622 622
623 (defun select-convert-from-integer (selection type value) 623 (defun select-convert-from-integer (selection type value)
624 (cond ((integerp value) ; Integer 624 (cond ((integerp value) ; Integer
625 value) 625 value)
626 626
627 ((and (consp value) ; (integer . integer) 627 ((and (consp value) ; (integer . integer)
628 (integerp (car value)) 628 (integerp (car value))
629 (integerp (cdr value))) 629 (integerp (cdr value)))
630 (if (eq (car value) 0) 630 (if (eq (car value) 0)
631 (cdr value) 631 (cdr value)
632 (if (and (eq (car value) -1) 632 (if (and (eq (car value) -1)
633 (< (cdr value) 0)) 633 (< (cdr value) 0))
634 (cdr value) 634 (cdr value)
635 value))) 635 value)))
636 636
637 ((and (listp value) ; (integer integer) 637 ((and (listp value) ; (integer integer)
638 (eq (length value) 2) 638 (eq (length value) 2)
639 (integerp (car value)) 639 (integerp (car value))
640 (integerp (cadr value))) 640 (integerp (cadr value)))
641 (if (eq (car value) 0) 641 (if (eq (car value) 0)
642 (cadr value) 642 (cadr value)
643 (if (and (eq (car value) -1) 643 (if (and (eq (car value) -1)
644 (< (cdr value) 0)) 644 (< (cdr value) 0))
645 (- (cadr value)) 645 (- (cadr value))
646 (cons (car value) (cadr value))))) 646 (cons (car value) (cadr value)))))
647 647
648 ((listp value) ; list 648 ((listp value) ; list
649 (if (cdr value) 649 (if (cdr value)
650 (mapcar '(lambda (x) 650 (mapcar '(lambda (x)
651 (select-convert-from-integer selection type x)) 651 (select-convert-from-integer selection type x))
652 value) 652 value)
653 (select-convert-from-integer selection type (car value)))) 653 (select-convert-from-integer selection type (car value))))
654 654
655 ((vectorp value) ; vector 655 ((vectorp value) ; vector
656 (if (eq (length value) 1) 656 (if (eq (length value) 1)
657 (select-convert-from-integer selection type (aref value 0)) 657 (select-convert-from-integer selection type (aref value 0))
658 (mapvector '(lambda (x) 658 (mapvector '(lambda (x)
659 (select-convert-from-integer selection type x)) 659 (select-convert-from-integer selection type x))
660 value))) 660 value)))
661 661
662 (t nil) 662 (t nil)
663 )) 663 ))
664 664
665 (defun select-convert-to-atom (selection type value) 665 (defun select-convert-to-atom (selection type value)
666 (and (symbolp value) value)) 666 (and (symbolp value) value))
738 value)) 738 value))
739 (t value))) 739 (t value)))
740 740
741 (defun select-buffer-killed-text (selection type value buffer) 741 (defun select-buffer-killed-text (selection type value buffer)
742 (select-buffer-killed-default selection type value buffer)) 742 (select-buffer-killed-default selection type value buffer))
743 743
744 ;; Types listed in here can be selections of XEmacs 744 ;; Types listed in here can be selections of XEmacs
745 (setq selection-converter-out-alist 745 (setq selection-converter-out-alist
746 '((TEXT . select-convert-to-text) 746 '((TEXT . select-convert-to-text)
747 (STRING . select-convert-to-string) 747 (STRING . select-convert-to-string)
748 (COMPOUND_TEXT . select-convert-to-compound-text) 748 (COMPOUND_TEXT . select-convert-to-compound-text)