Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 404:2f8bb876ab1d r21-2-32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-32
author cvs
date Mon, 13 Aug 2007 11:16:07 +0200
parents 74fd4e045ea6
children de805c49cfc1
comparison
equal deleted inserted replaced
403:9f011ab08d48 404:2f8bb876ab1d
81 (define-device-method get-cutbuffer 81 (define-device-method get-cutbuffer
82 "Return the value of one of the cut buffers. 82 "Return the value of one of the cut buffers.
83 This will do nothing under anything other than X.") 83 This will do nothing under anything other than X.")
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 Windows 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 err (get-selection type data-type) (t nil))) 90 (condition-case err (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 Windows 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,
95 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) 95 and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule)
96 says how to convert the data. If there is no selection an error is signalled." 96 says how to convert the data. If there is no selection an error is signalled."
97 (or type (setq type 'PRIMARY)) 97 (or type (setq type 'PRIMARY))
98 (or data-type (setq data-type selected-text-type)) 98 (or data-type (setq data-type selected-text-type))
110 (when (not (stringp text)) 110 (when (not (stringp text))
111 (error "Selection is not a string: %S" text)) 111 (error "Selection is not a string: %S" text))
112 text)) 112 text))
113 113
114 ;; FSFmacs calls this `x-set-selection', and reverses the 114 ;; FSFmacs calls this `x-set-selection', and reverses the
115 ;; arguments (duh ...). This order is more logical. 115 ;; first two arguments (duh ...). This order is more logical.
116 (defun own-selection (data &optional type) 116 (defun own-selection (data &optional type append)
117 "Make an Windows selection of type TYPE and value DATA. 117 "Make a window-system selection of type TYPE and value DATA.
118 The argument TYPE (default `PRIMARY') says which selection, 118 The argument TYPE (default `PRIMARY') says which selection,
119 and DATA specifies the contents. DATA may be a string, 119 and DATA specifies the contents. DATA may be a string,
120 a symbol, an integer (or a cons of two integers or list of two integers). 120 a symbol, an integer (or a cons of two integers or list of two integers).
121 If APPEND is non-nil, append the data to the existing selection data.
121 122
122 The selection may also be a cons of two markers pointing to the same buffer, 123 The selection may also be a cons of two markers pointing to the same buffer,
123 or an overlay. In these cases, the selection is considered to be the text 124 or an overlay. In these cases, the selection is considered to be the text
124 between the markers *at whatever time the selection is examined*. 125 between the markers *at whatever time the selection is examined*.
125 Thus, editing done in the buffer after you specify the selection 126 Thus, editing done in the buffer after you specify the selection
129 130
130 Interactively, the text of the region is used as the selection value." 131 Interactively, the text of the region is used as the selection value."
131 (interactive (if (not current-prefix-arg) 132 (interactive (if (not current-prefix-arg)
132 (list (read-string "Store text for pasting: ")) 133 (list (read-string "Store text for pasting: "))
133 (list (substring (region-beginning) (region-end))))) 134 (list (substring (region-beginning) (region-end)))))
134 ;FSFmacs huh?? It says: 135 ;; calling own-selection-internal will mess this up, so preserve it.
135 ;; "This is for temporary compatibility with pre-release Emacs 19." 136 (let ((zmacs-region-stays zmacs-region-stays))
136 ;(if (stringp type) 137 ;FSFmacs huh?? It says:
137 ; (setq type (intern type))) 138 ;; "This is for temporary compatibility with pre-release Emacs 19."
138 (or (valid-simple-selection-p data) 139 ;(if (stringp type)
139 (and (vectorp data) 140 ; (setq type (intern type)))
140 (let ((valid t) 141 (or (valid-simple-selection-p data)
141 (i (1- (length data)))) 142 (and (vectorp data)
142 (while (>= i 0) 143 (let ((valid t)
143 (or (valid-simple-selection-p (aref data i)) 144 (i (1- (length data))))
144 (setq valid nil)) 145 (while (>= i 0)
145 (setq i (1- i))) 146 (or (valid-simple-selection-p (aref data i))
146 valid)) 147 (setq valid nil))
147 (signal 'error (list "invalid selection" data))) 148 (setq i (1- i)))
148 (or type (setq type 'PRIMARY)) 149 valid))
149 (if (null data) 150 (signal 'error (list "invalid selection" data)))
150 (disown-selection-internal type) 151 (or type (setq type 'PRIMARY))
151 (own-selection-internal type data) 152 (flet ((own-selection-1
152 (when (and (eq type 'PRIMARY) 153 (type data append)
153 selection-sets-clipboard) 154 (when append
154 (own-selection-internal 'CLIPBOARD data))) 155 (unless (stringp data)
155 (cond ((eq type 'PRIMARY) 156 ;; kludge!
156 (setq primary-selection-extent 157 (setq data (select-convert-to-text type 'STRING data))
157 (select-make-extent-for-selection 158 (if (stringp data)
158 data primary-selection-extent))) 159 (setq data (concat (get-selection type) data)))))
159 ((eq type 'SECONDARY) 160 (own-selection-internal type data)))
160 (setq secondary-selection-extent 161 (if (null data)
161 (select-make-extent-for-selection 162 (disown-selection-internal type)
162 data secondary-selection-extent)))) 163 (own-selection-1 type data append)
163 (setq zmacs-region-stays t) 164 (when (and (eq type 'PRIMARY)
165 selection-sets-clipboard)
166 (own-selection-internal 'CLIPBOARD data append))))
167 (cond ((eq type 'PRIMARY)
168 (setq primary-selection-extent
169 (select-make-extent-for-selection
170 data primary-selection-extent)))
171 ((eq type 'SECONDARY)
172 (setq secondary-selection-extent
173 (select-make-extent-for-selection
174 data secondary-selection-extent)))))
175 ;; zmacs-region-stays is for commands, not low-level functions.
176 ;; when behaving as the latter, we better not set it, or we will
177 ;; cause unwanted sticky-region behavior in kill-region and friends.
178 (if (interactive-p)
179 (setq zmacs-region-stays t))
164 data) 180 data)
165 181
166 (defun dehilight-selection (selection) 182 (defun dehilight-selection (selection)
167 "for use as a value of `lost-selection-hooks'." 183 "for use as a value of `lost-selection-hooks'."
168 (cond ((eq selection 'PRIMARY) 184 (cond ((eq selection 'PRIMARY)
182 (setq secondary-selection-extent nil))))) 198 (setq secondary-selection-extent nil)))))
183 nil) 199 nil)
184 200
185 (setq lost-selection-hooks 'dehilight-selection) 201 (setq lost-selection-hooks 'dehilight-selection)
186 202
187 (defun own-clipboard (string) 203 (defun own-clipboard (string &optional append)
188 "Paste the given string to the window system Clipboard." 204 "Paste the given string to the window system Clipboard.
205 If APPEND is non-nil, append the string to the existing contents."
189 (own-selection string 'CLIPBOARD)) 206 (own-selection string 'CLIPBOARD))
190 207
191 (defun disown-selection (&optional secondary-p) 208 (defun disown-selection (&optional secondary-p)
192 "Assuming we own the selection, disown it. With an argument, discard the 209 "Assuming we own the selection, disown it. With an argument, discard the
193 secondary selection instead of the primary selection." 210 secondary selection instead of the primary selection."