Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 418:e804706bfb8c r21-2-17

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-17
author cvs
date Mon, 13 Aug 2007 11:23:13 +0200
parents ebe98a74bd68
children 11054d720c21
comparison
equal deleted inserted replaced
417:43a18b32d56e 418:e804706bfb8c
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-is-clipboard-p 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 ()
73 73
74 (define-device-method get-cutbuffer 74 (define-device-method get-cutbuffer
75 "Return the value of one of the cut buffers. 75 "Return the value of one of the cut buffers.
76 This will do nothing under anything other than X.") 76 This will do nothing under anything other than X.")
77 77
78 (defun get-selection-no-error (&optional type data-type)
79 "Return the value of a Windows selection.
80 The argument TYPE (default `PRIMARY') says which selection,
81 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
82 says how to convert the data. Returns NIL if there is no selection"
83 (condition-case err (get-selection type data-type) (t nil)))
84
78 (defun get-selection (&optional type data-type) 85 (defun get-selection (&optional type data-type)
79 "Return the value of a Windows selection. 86 "Return the value of a Windows selection.
80 The argument TYPE (default `PRIMARY') says which selection, 87 The argument TYPE (default `PRIMARY') says which selection,
81 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)
82 says how to convert the data. If there is no selection an error is signalled." 89 says how to convert the data. If there is no selection an error is signalled."
83 (let ((text (get-selection-no-error type data-type)))
84 (when (not (stringp text))
85 (error "Selection is not a string: %S" text))
86 text))
87
88 (defun get-selection-no-error (&optional type data-type)
89 "Return the value of a Windows selection.
90 The argument TYPE (default `PRIMARY') says which selection,
91 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
92 says how to convert the data. Returns NIL if there is no selection"
93 (or type (setq type 'PRIMARY)) 90 (or type (setq type 'PRIMARY))
94 (or data-type (setq data-type selected-text-type)) 91 (or data-type (setq data-type selected-text-type))
95 (let ((text 92 (let ((text
96 (if (consp data-type) 93 (if (consp data-type)
97 (condition-case err 94 (condition-case err
101 (get-selection type (cdr data-type)) 98 (get-selection type (cdr data-type))
102 (signal (car err) (cdr err))))) 99 (signal (car err) (cdr err)))))
103 (get-selection-internal type data-type)))) 100 (get-selection-internal type data-type))))
104 (when (and (consp text) (symbolp (car text))) 101 (when (and (consp text) (symbolp (car text)))
105 (setq text (cdr text))) 102 (setq text (cdr text)))
103 (when (not (stringp text))
104 (error "Selection is not a string: %S" text))
106 text)) 105 text))
107 106
108 ;; FSFmacs calls this `x-set-selection', and reverses the 107 ;; FSFmacs calls this `x-set-selection', and reverses the
109 ;; arguments (duh ...). This order is more logical. 108 ;; arguments (duh ...). This order is more logical.
110 (defun own-selection (data &optional type) 109 (defun own-selection (data &optional type)
142 (or type (setq type 'PRIMARY)) 141 (or type (setq type 'PRIMARY))
143 (if (null data) 142 (if (null data)
144 (disown-selection-internal type) 143 (disown-selection-internal type)
145 (own-selection-internal type data) 144 (own-selection-internal type data)
146 (when (and (eq type 'PRIMARY) 145 (when (and (eq type 'PRIMARY)
147 selection-is-clipboard-p) 146 selection-sets-clipboard)
148 (own-selection-internal 'CLIPBOARD data))) 147 (own-selection-internal 'CLIPBOARD data)))
149 (cond ((eq type 'PRIMARY) 148 (cond ((eq type 'PRIMARY)
150 (setq primary-selection-extent 149 (setq primary-selection-extent
151 (select-make-extent-for-selection 150 (select-make-extent-for-selection
152 data primary-selection-extent))) 151 data primary-selection-extent)))