Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 280:7df0dd720c89 r21-0b38

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b38
author cvs
date Mon, 13 Aug 2007 10:32:22 +0200
parents
children 558f606b08ae
comparison
equal deleted inserted replaced
279:c20b2fb5bb0a 280:7df0dd720c89
1 ;;; select.el --- Lisp interface to windows selections.
2
3 ;; Copyright (C) 1998 Andy Piper.
4 ;; Copyright (C) 1990, 1997 Free Software Foundation, Inc.
5 ;; Copyright (C) 1995 Sun Microsystems.
6
7 ;; Maintainer: XEmacs Development Team
8 ;; Keywords: extensions, dumped
9
10 ;; This file is part of XEmacs.
11
12 ;; XEmacs 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 ;; XEmacs is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public 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
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
26
27 ;;; Synched up with: Not in FSF
28
29 ;;; Commentary:
30
31 ;; This file is dumped with XEmacs
32
33 ;;; Code:
34
35 (defun copy-primary-selection ()
36 "Copy the selection to the Clipboard and the kill ring."
37 (interactive)
38 (case (device-type (selected-device))
39 (x (x-copy-primary-selection))
40 (mswindows (mswindows-copy-clipboard))
41 (otherwise nil)))
42
43 (defun kill-primary-selection ()
44 "Copy the selection to the Clipboard and the kill ring, then delete it."
45 (interactive "*")
46 (case (device-type (selected-device))
47 (x (x-kill-primary-selection))
48 (mswindows (mswindows-cut-clipboard))
49 (otherwise nil)))
50
51 (defun delete-primary-selection ()
52 "Delete the selection without copying it to the Clipboard or the kill ring."
53 (interactive "*")
54 (case (device-type (selected-device))
55 (x (x-delete-primary-selection))
56 (otherwise nil)))
57
58 (defun yank-clipboard-selection ()
59 "Insert the current Clipboard selection at point."
60 (interactive "*")
61 (case (device-type (selected-device))
62 (x (x-yank-clipboard-selection))
63 (mswindows (mswindows-paste-clipboard))
64 (otherwise nil)))
65
66 (defun selection-owner-p (&optional selection)
67 "Return t if current emacs process owns the given Selection.
68 The arg should be the name of the selection in question, typically one
69 of the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience,
70 the symbol nil is the same as PRIMARY, and t is the same as
71 SECONDARY.)"
72 (interactive)
73 (case (device-type (selected-device))
74 (x (x-selection-owner-p selection))
75 (mswindows (mswindows-selection-owner-p selection))
76 (otherwise nil)))
77
78 (defun selection-exists-p (&optional selection)
79 "Whether there is an owner for the given Selection.
80 The arg should be the name of the selection in question, typically one
81 of the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience,
82 the symbol nil is the same as PRIMARY, and t is the same as
83 SECONDARY."
84 (interactive)
85 (case (device-type (selected-device))
86 (x (x-selection-exists-p selection))
87 (mswindows t)
88 (otherwise nil)))
89
90 (defun own-selection (data &optional type)
91 "Make an Windows selection of type TYPE and value DATA.
92 The argument TYPE (default `PRIMARY') says which selection,
93 and DATA specifies the contents. DATA may be a string,
94 a symbol, an integer (or a cons of two integers or list of two integers).
95
96 The selection may also be a cons of two markers pointing to the same buffer,
97 or an overlay. In these cases, the selection is considered to be the text
98 between the markers *at whatever time the selection is examined*.
99 Thus, editing done in the buffer after you specify the selection
100 can alter the effective value of the selection.
101
102 The data may also be a vector of valid non-vector selection values.
103
104 Interactively, the text of the region is used as the selection value."
105 (interactive (if (not current-prefix-arg)
106 (list (read-string "Store text for pasting: "))
107 (list (substring (region-beginning) (region-end)))))
108 (case (device-type (selected-device))
109 (x (x-own-selection data type))
110 (mswindows (mswindows-own-selection data type))
111 (otherwise nil)))
112
113 (defun disown-selection (&optional secondary-p)
114 "Assuming we own the selection, disown it. With an argument, discard the
115 secondary selection instead of the primary selection."
116 (case (device-type (selected-device))
117 (x (x-disown-selection secondary-p))
118 (mswindows (mswindows-disown-selection secondary-p))
119 (otherwise nil)))
120
121 ;; from x-init.el
122 ;; selections and active regions
123
124 ;; If and only if zmacs-regions is true:
125
126 ;; When a mark is pushed and the region goes into the "active" state, we
127 ;; assert it as the Primary selection. This causes it to be hilighted.
128 ;; When the region goes into the "inactive" state, we disown the Primary
129 ;; selection, causing the region to be dehilighted.
130
131 ;; Note that it is possible for the region to be in the "active" state
132 ;; and not be hilighted, if it is in the active state and then some other
133 ;; application asserts the selection. This is probably not a big deal.
134
135 (defun activate-region-as-selection ()
136 (if (marker-buffer (mark-marker t))
137 (own-selection (cons (point-marker t) (mark-marker t)))))
138
139 ; moved from x-select.el
140 (defvar primary-selection-extent nil
141 "The extent of the primary selection; don't use this.")
142
143 (defvar secondary-selection-extent nil
144 "The extent of the secondary selection; don't use this.")
145
146 (defun select-make-extent-for-selection (selection previous-extent)
147 ;; Given a selection, this makes an extent in the buffer which holds that
148 ;; selection, for highlighting purposes. If the selection isn't associated
149 ;; with a buffer, this does nothing.
150 (let ((buffer nil)
151 (valid (and (extentp previous-extent)
152 (extent-object previous-extent)
153 (buffer-live-p (extent-object previous-extent))))
154 start end)
155 (cond ((stringp selection)
156 ;; if we're selecting a string, lose the previous extent used
157 ;; to highlight the selection.
158 (setq valid nil))
159 ((consp selection)
160 (setq start (min (car selection) (cdr selection))
161 end (max (car selection) (cdr selection))
162 valid (and valid
163 (eq (marker-buffer (car selection))
164 (extent-object previous-extent)))
165 buffer (marker-buffer (car selection))))
166 ((extentp selection)
167 (setq start (extent-start-position selection)
168 end (extent-end-position selection)
169 valid (and valid
170 (eq (extent-object selection)
171 (extent-object previous-extent)))
172 buffer (extent-object selection)))
173 (t
174 (signal 'error (list "invalid selection" selection))))
175
176 (if valid
177 nil
178 (condition-case ()
179 (if (listp previous-extent)
180 (mapcar 'delete-extent previous-extent)
181 (delete-extent previous-extent))
182 (error nil)))
183
184 (if (not buffer)
185 ;; string case
186 nil
187 ;; normal case
188 (if valid
189 (set-extent-endpoints previous-extent start end)
190 (setq previous-extent (make-extent start end buffer))
191
192 ;; Make the extent be closed on the right, which means that if
193 ;; characters are inserted exactly at the end of the extent, the
194 ;; extent will grow to cover them. This is important for shell
195 ;; buffers - suppose one makes a selection, and one end is at
196 ;; point-max. If the shell produces output, that marker will remain
197 ;; at point-max (its position will increase). So it's important that
198 ;; the extent exhibit the same behavior, lest the region covered by
199 ;; the extent (the visual indication), and the region between point
200 ;; and mark (the actual selection value) become different!
201 (set-extent-property previous-extent 'end-open nil)
202
203 (cond
204 (mouse-track-rectangle-p
205 (setq previous-extent (list previous-extent))
206 (default-mouse-track-next-move-rect start end previous-extent)
207 ))
208 previous-extent))))
209
210 ;; moved from x-select.el
211 (defun valid-simple-selection-p (data)
212 (or (stringp data)
213 ;FSFmacs huh?? (symbolp data)
214 (integerp data)
215 (and (consp data)
216 (integerp (car data))
217 (or (integerp (cdr data))
218 (and (consp (cdr data))
219 (integerp (car (cdr data))))))
220 (extentp data)
221 (and (consp data)
222 (markerp (car data))
223 (markerp (cdr data))
224 (marker-buffer (car data))
225 (marker-buffer (cdr data))
226 (eq (marker-buffer (car data))
227 (marker-buffer (cdr data)))
228 (buffer-live-p (marker-buffer (car data)))
229 (buffer-live-p (marker-buffer (cdr data))))))
230
231 ;;; select.el ends here