Mercurial > hg > xemacs-beta
comparison lisp/mouse.el @ 414:da8ed4261e83 r21-2-15
Import from CVS: tag r21-2-15
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 11:21:38 +0200 |
| parents | 697ef44129c6 |
| children | ebe98a74bd68 |
comparison
equal
deleted
inserted
replaced
| 413:901169e5ca31 | 414:da8ed4261e83 |
|---|---|
| 82 | 82 |
| 83 (defvar mouse-yank-function 'mouse-consolidated-yank | 83 (defvar mouse-yank-function 'mouse-consolidated-yank |
| 84 "Function that is called upon by `mouse-yank' to actually insert text.") | 84 "Function that is called upon by `mouse-yank' to actually insert text.") |
| 85 | 85 |
| 86 (defun mouse-consolidated-yank () | 86 (defun mouse-consolidated-yank () |
| 87 "Insert the current selection or, if there is none under X insert the X cutbuffer. | |
| 88 A mark is pushed, so that the inserted text lies between point and mark." | |
| 87 (interactive) | 89 (interactive) |
| 88 (case (device-type) | 90 (if (not (console-on-window-system-p)) |
| 89 (x (x-yank-function)) | 91 (yank) |
| 90 (tty (yank)) | 92 (push-mark) |
| 91 (otherwise (yank)))) | 93 (if (region-active-p) |
| 94 (if (consp zmacs-region-extent) | |
| 95 ;; pirated code from insert-rectangle in rect.el | |
| 96 ;; perhaps that code should be modified to handle a list of extents | |
| 97 ;; as the rectangle to be inserted? | |
| 98 (let ((lines zmacs-region-extent) | |
| 99 (insertcolumn (current-column)) | |
| 100 (first t)) | |
| 101 (push-mark) | |
| 102 (while lines | |
| 103 (or first | |
| 104 (progn | |
| 105 (forward-line 1) | |
| 106 (or (bolp) (insert ?\n)) | |
| 107 (move-to-column insertcolumn t))) | |
| 108 (setq first nil) | |
| 109 (insert (extent-string (car lines))) | |
| 110 (setq lines (cdr lines)))) | |
| 111 (insert (extent-string zmacs-region-extent))) | |
| 112 (insert-selection t)))) | |
| 113 | |
| 114 (defun insert-selection (&optional check-cutbuffer-p move-point-event) | |
| 115 "Insert the current selection into buffer at point." | |
| 116 (interactive "P") | |
| 117 (let ((text (if check-cutbuffer-p | |
| 118 (or (condition-case () (get-selection) (error ())) | |
| 119 (get-cutbuffer) | |
| 120 (error "No selection or cut buffer available")) | |
| 121 (get-selection)))) | |
| 122 (cond (move-point-event | |
| 123 (mouse-set-point move-point-event) | |
| 124 (push-mark (point))) | |
| 125 ((interactive-p) | |
| 126 (push-mark (point)))) | |
| 127 (insert text) | |
| 128 )) | |
| 92 | 129 |
| 93 | 130 |
| 94 (defun mouse-select () | 131 (defun mouse-select () |
| 95 "Select Emacs window the mouse is on." | 132 "Select Emacs window the mouse is on." |
| 96 (interactive "@")) | 133 (interactive "@")) |