Mercurial > hg > xemacs-beta

comparison lisp/select.el @ 286:57709be46d1b r21-0b41

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b41
author cvs
date Mon, 13 Aug 2007 10:35:03 +0200
parents 558f606b08ae
children 3cc9f0ebfbd1
comparison
equal deleted inserted replaced
285:9a3756523c1b 286:57709be46d1b
33 ;;; Code: 33 ;;; Code:
34 34
35 (defun copy-primary-selection () 35 (defun copy-primary-selection ()
36 "Copy the selection to the Clipboard and the kill ring." 36 "Copy the selection to the Clipboard and the kill ring."
37 (interactive) 37 (interactive)
38 (case (device-type (selected-device)) 38 (and (console-on-window-system-p)
39 (x (x-copy-primary-selection)) 39 (cut-copy-clear-internal 'copy)))
40 (mswindows (mswindows-copy-clipboard))
41 (otherwise nil)))
42 40
43 (defun kill-primary-selection () 41 (defun kill-primary-selection ()
44 "Copy the selection to the Clipboard and the kill ring, then delete it." 42 "Copy the selection to the Clipboard and the kill ring, then delete it."
45 (interactive "*") 43 (interactive "*")
46 (case (device-type (selected-device)) 44 (and (console-on-window-system-p)
47 (x (x-kill-primary-selection)) 45 (cut-copy-clear-internal 'cut)))
48 (mswindows (mswindows-cut-clipboard))
49 (otherwise nil)))
50 46
51 (defun delete-primary-selection () 47 (defun delete-primary-selection ()
52 "Delete the selection without copying it to the Clipboard or the kill ring." 48 "Delete the selection without copying it to the Clipboard or the kill ring."
53 (interactive "*") 49 (interactive "*")
54 (case (device-type (selected-device)) 50 (and (console-on-window-system-p)
55 (x (x-delete-primary-selection)) 51 (cut-copy-clear-internal 'clear)))
56 (mswindows (mswindows-clear-clipboard))
57 (otherwise nil)))
58 52
59 (defun yank-clipboard-selection () 53 (defun yank-clipboard-selection ()
60 "Insert the current Clipboard selection at point." 54 "Insert the current Clipboard selection at point."
61 (interactive "*") 55 (interactive "*")
62 (case (device-type (selected-device)) 56 (case (device-type (selected-device))
83 the symbol nil is the same as PRIMARY, and t is the same as 77 the symbol nil is the same as PRIMARY, and t is the same as
84 SECONDARY." 78 SECONDARY."
85 (interactive) 79 (interactive)
86 (case (device-type (selected-device)) 80 (case (device-type (selected-device))
87 (x (x-selection-exists-p selection)) 81 (x (x-selection-exists-p selection))
88 (mswindows t) 82 (mswindows (mswindows-selection-exists-p))
89 (otherwise nil))) 83 (otherwise nil)))
90 84
91 (defun own-selection (data &optional type) 85 (defun own-selection (data &optional type)
92 "Make an Windows selection of type TYPE and value DATA. 86 "Make an Windows selection of type TYPE and value DATA.
93 The argument TYPE (default `PRIMARY') says which selection, 87 The argument TYPE (default `PRIMARY') says which selection,
109 (case (device-type (selected-device)) 103 (case (device-type (selected-device))
110 (x (x-own-selection data type)) 104 (x (x-own-selection data type))
111 (mswindows (mswindows-own-selection data type)) 105 (mswindows (mswindows-own-selection data type))
112 (otherwise nil))) 106 (otherwise nil)))
113 107
108 (defun own-clipboard (string)
109 "Paste the given string to the Clipboard."
110 (case (device-type (selected-device))
111 (x (x-own-clipboard string))
112 (mswindows (mswindows-own-clipboard string))
113 (otherwise nil)))
114
114 (defun disown-selection (&optional secondary-p) 115 (defun disown-selection (&optional secondary-p)
115 "Assuming we own the selection, disown it. With an argument, discard the 116 "Assuming we own the selection, disown it. With an argument, discard the
116 secondary selection instead of the primary selection." 117 secondary selection instead of the primary selection."
117 (case (device-type (selected-device)) 118 (case (device-type (selected-device))
118 (x (x-disown-selection secondary-p)) 119 (x (x-disown-selection secondary-p))
119 (mswindows (mswindows-disown-selection secondary-p)) 120 (mswindows (mswindows-disown-selection secondary-p))
120 (otherwise nil))) 121 (otherwise nil)))
122
121 123
122 ;; from x-init.el 124 ;; from x-init.el
123 ;; selections and active regions 125 ;; selections and active regions
124 126
125 ;; If and only if zmacs-regions is true: 127 ;; If and only if zmacs-regions is true:
227 (eq (marker-buffer (car data)) 229 (eq (marker-buffer (car data))
228 (marker-buffer (cdr data))) 230 (marker-buffer (cdr data)))
229 (buffer-live-p (marker-buffer (car data))) 231 (buffer-live-p (marker-buffer (car data)))
230 (buffer-live-p (marker-buffer (cdr data)))))) 232 (buffer-live-p (marker-buffer (cdr data))))))
231 233
234 (defun cut-copy-clear-internal (mode)
235 (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode))
236 (or (selection-owner-p)
237 (error "emacs does not own the primary selection"))
238 (setq last-command nil)
239 (or primary-selection-extent
240 (error "the primary selection is not an extent?"))
241 (save-excursion
242 (let (rect-p b s e)
243 (cond
244 ((consp primary-selection-extent)
245 (setq rect-p t
246 b (extent-object (car primary-selection-extent))
247 s (extent-start-position (car primary-selection-extent))
248 e (extent-end-position (car (reverse primary-selection-extent)))))
249 (t
250 (setq rect-p nil
251 b (extent-object primary-selection-extent)
252 s (extent-start-position primary-selection-extent)
253 e (extent-end-position primary-selection-extent))))
254 (set-buffer b)
255 (cond ((memq mode '(cut copy))
256 (if rect-p
257 (progn
258 ;; why is killed-rectangle free? Is it used somewhere?
259 ;; should it be defvarred?
260 (setq killed-rectangle (extract-rectangle s e))
261 (kill-new (mapconcat 'identity killed-rectangle "\n")))
262 (copy-region-as-kill s e))
263 ;; Maybe killing doesn't own clipboard. Make sure it happens.
264 ;; This memq is kind of grody, because they might have done it
265 ;; some other way, but owning the clipboard twice in that case
266 ;; wouldn't actually hurt anything.
267 (or (and (consp kill-hooks) (memq 'own-clipboard kill-hooks))
268 (own-clipboard (car kill-ring)))))
269 (cond ((memq mode '(cut clear))
270 (if rect-p
271 (delete-rectangle s e)
272 (delete-region s e))))
273 (disown-selection nil)
274 )))
275
232 ;;; select.el ends here 276 ;;; select.el ends here