Mercurial > hg > xemacs-beta
comparison lisp/x-select.el @ 286:57709be46d1b r21-0b41
Import from CVS: tag r21-0b41
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 10:35:03 +0200 |
| parents | 7df0dd720c89 |
| children | 74fd4e045ea6 |
comparison
equal
deleted
inserted
replaced
| 285:9a3756523c1b | 286:57709be46d1b |
|---|---|
| 250 (x-store-cutbuffer-internal 'CUT_BUFFER0 string)))) | 250 (x-store-cutbuffer-internal 'CUT_BUFFER0 string)))) |
| 251 | 251 |
| 252 | 252 |
| 253 ;;; Random utility functions | 253 ;;; Random utility functions |
| 254 | 254 |
| 255 (defun x-cut-copy-clear-internal (mode) | |
| 256 (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode)) | |
| 257 (or (x-selection-owner-p) | |
| 258 (error "emacs does not own the primary selection")) | |
| 259 (setq last-command nil) | |
| 260 (or primary-selection-extent | |
| 261 (error "the primary selection is not an extent?")) | |
| 262 (save-excursion | |
| 263 (let (rect-p b s e) | |
| 264 (cond | |
| 265 ((consp primary-selection-extent) | |
| 266 (setq rect-p t | |
| 267 b (extent-object (car primary-selection-extent)) | |
| 268 s (extent-start-position (car primary-selection-extent)) | |
| 269 e (extent-end-position (car (reverse primary-selection-extent))))) | |
| 270 (t | |
| 271 (setq rect-p nil | |
| 272 b (extent-object primary-selection-extent) | |
| 273 s (extent-start-position primary-selection-extent) | |
| 274 e (extent-end-position primary-selection-extent)))) | |
| 275 (set-buffer b) | |
| 276 (cond ((memq mode '(cut copy)) | |
| 277 (if rect-p | |
| 278 (progn | |
| 279 ;; why is killed-rectangle free? Is it used somewhere? | |
| 280 ;; should it be defvarred? | |
| 281 (setq killed-rectangle (extract-rectangle s e)) | |
| 282 (kill-new (mapconcat 'identity killed-rectangle "\n"))) | |
| 283 (copy-region-as-kill s e)) | |
| 284 ;; Maybe killing doesn't own clipboard. Make sure it happens. | |
| 285 ;; This memq is kind of grody, because they might have done it | |
| 286 ;; some other way, but owning the clipboard twice in that case | |
| 287 ;; wouldn't actually hurt anything. | |
| 288 (or (and (consp kill-hooks) (memq 'x-own-clipboard kill-hooks)) | |
| 289 (x-own-clipboard (car kill-ring))))) | |
| 290 (cond ((memq mode '(cut clear)) | |
| 291 (if rect-p | |
| 292 (delete-rectangle s e) | |
| 293 (delete-region s e)))) | |
| 294 (x-disown-selection nil) | |
| 295 ))) | |
| 296 | |
| 297 (defun x-copy-primary-selection () | |
| 298 "Copy the selection to the Clipboard and the kill ring." | |
| 299 (interactive) | |
| 300 (x-cut-copy-clear-internal 'copy)) | |
| 301 | |
| 302 (defun x-kill-primary-selection () | |
| 303 "Copy the selection to the Clipboard and the kill ring, then delete it." | |
| 304 (interactive "*") | |
| 305 (x-cut-copy-clear-internal 'cut)) | |
| 306 | |
| 307 (defun x-delete-primary-selection () | |
| 308 "Delete the selection without copying it to the Clipboard or the kill ring." | |
| 309 (interactive "*") | |
| 310 (x-cut-copy-clear-internal 'clear)) | |
| 311 | |
| 312 (defun x-yank-clipboard-selection () | 255 (defun x-yank-clipboard-selection () |
| 313 "Insert the current Clipboard selection at point." | 256 "Insert the current Clipboard selection at point." |
| 314 (interactive "*") | 257 (interactive "*") |
| 315 (setq last-command nil) | 258 (setq last-command nil) |
| 316 (setq this-command 'yank) ; so that yank-pop works. | 259 (setq this-command 'yank) ; so that yank-pop works. |