Mercurial > emacs
comparison lisp/mouse.el @ 7966:76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
(mouse-drag-region, mouse-drag-secondary): Accept any list event
as normal termination of the dragging.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Sun, 19 Jun 1994 18:04:35 +0000 |
| parents | ac4b606bcfa2 |
| children | d04a39ce4f1d |
comparison
equal
deleted
inserted
replaced
| 7965:a563319a7968 | 7966:76118755a179 |
|---|---|
| 160 (defun mouse-scroll-subr (window jump &optional overlay start) | 160 (defun mouse-scroll-subr (window jump &optional overlay start) |
| 161 "Scroll the window WINDOW, JUMP lines at a time, until new input arrives. | 161 "Scroll the window WINDOW, JUMP lines at a time, until new input arrives. |
| 162 If OVERLAY is an overlay, let it stretch from START to the far edge of | 162 If OVERLAY is an overlay, let it stretch from START to the far edge of |
| 163 the newly visible text. | 163 the newly visible text. |
| 164 Upon exit, point is at the far edge of the newly visible text." | 164 Upon exit, point is at the far edge of the newly visible text." |
| 165 (while (progn | 165 (let ((opoint (point))) |
| 166 (goto-char (window-start window)) | 166 (while (progn |
| 167 (if (not (zerop (vertical-motion jump window))) | 167 (goto-char (window-start window)) |
| 168 (progn | 168 (if (not (zerop (vertical-motion jump window))) |
| 169 (set-window-start window (point)) | 169 (progn |
| 170 (if (natnump jump) | 170 (set-window-start window (point)) |
| 171 (progn | 171 (if (natnump jump) |
| 172 (goto-char (window-end window)) | 172 (progn |
| 173 ;; window-end doesn't reflect the window's new | 173 (goto-char (window-end window)) |
| 174 ;; start position until the next redisplay. Hurrah. | 174 ;; window-end doesn't reflect the window's new |
| 175 (vertical-motion (1- jump) window)) | 175 ;; start position until the next redisplay. Hurrah. |
| 176 (goto-char (window-start window))) | 176 (vertical-motion (1- jump) window)) |
| 177 (if overlay | 177 (goto-char (window-start window))) |
| 178 (move-overlay overlay start (point))) | 178 (if overlay |
| 179 (if (not (eobp)) | 179 (move-overlay overlay start (point))) |
| 180 (sit-for mouse-scroll-delay)))))) | 180 ;; Now that we have scrolled WINDOW properly, |
| 181 (point)) | 181 ;; put point back where it was for the redisplay |
| 182 ;; so that we don't mess up the selected window. | |
| 183 (or (eq window (selected-window)) | |
| 184 (goto-char opoint)) | |
| 185 (if (not (eobp)) | |
| 186 (sit-for mouse-scroll-delay)))))) | |
| 187 (or (eq window (selected-window)) | |
| 188 (goto-char opoint)))) | |
| 182 | 189 |
| 183 (defvar mouse-drag-overlay (make-overlay 1 1)) | 190 (defvar mouse-drag-overlay (make-overlay 1 1)) |
| 184 (overlay-put mouse-drag-overlay 'face 'region) | 191 (overlay-put mouse-drag-overlay 'face 'region) |
| 185 | 192 |
| 186 (defvar mouse-selection-click-count 0) | 193 (defvar mouse-selection-click-count 0) |
| 242 mouse-drag-overlay start-point)) | 249 mouse-drag-overlay start-point)) |
| 243 ((and (not (eobp)) | 250 ((and (not (eobp)) |
| 244 (>= mouse-row bottom)) | 251 (>= mouse-row bottom)) |
| 245 (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) | 252 (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) |
| 246 mouse-drag-overlay start-point))))))))) | 253 mouse-drag-overlay start-point))))))))) |
| 247 | 254 (if (consp event) |
| 248 (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click) | 255 ;;; When we scroll into the mode line or menu bar, or out of the window, |
| 249 (eq (posn-window (event-end event)) start-window) | 256 ;;; we get events that don't fit these criteria. |
| 250 (numberp (posn-point (event-end event)))) | 257 ;;; (eq (get (event-basic-type event) 'event-kind) 'mouse-click) |
| 258 ;;; (eq (posn-window (event-end event)) start-window) | |
| 259 ;;; (numberp (posn-point (event-end event))) | |
| 251 (let ((fun (key-binding (vector (car event))))) | 260 (let ((fun (key-binding (vector (car event))))) |
| 252 (if (memq fun '(mouse-set-region mouse-set-point)) | 261 (if (not (= (overlay-start mouse-drag-overlay) |
| 253 (if (not (= (overlay-start mouse-drag-overlay) | 262 (overlay-end mouse-drag-overlay))) |
| 254 (overlay-end mouse-drag-overlay))) | 263 (let (last-command) |
| 255 (let (last-command) | 264 (push-mark (overlay-start mouse-drag-overlay) t t) |
| 256 (push-mark (overlay-start mouse-drag-overlay) t t) | |
| 257 (goto-char (overlay-end mouse-drag-overlay)) | |
| 258 (copy-region-as-kill (point) (mark t))) | |
| 259 (goto-char (overlay-end mouse-drag-overlay)) | 265 (goto-char (overlay-end mouse-drag-overlay)) |
| 260 (setq this-command 'mouse-set-point)) | 266 (copy-region-as-kill (point) (mark t))) |
| 261 (if (fboundp fun) | 267 (goto-char (overlay-end mouse-drag-overlay)) |
| 262 (funcall fun event))))) | 268 (setq this-command 'mouse-set-point)))) |
| 263 (delete-overlay mouse-drag-overlay)))) | 269 (delete-overlay mouse-drag-overlay)))) |
| 264 | 270 |
| 265 ;; Commands to handle xterm-style multiple clicks. | 271 ;; Commands to handle xterm-style multiple clicks. |
| 266 | 272 |
| 267 (defun mouse-skip-word (dir) | 273 (defun mouse-skip-word (dir) |
| 640 ((and (not (eobp)) | 646 ((and (not (eobp)) |
| 641 (>= mouse-row bottom)) | 647 (>= mouse-row bottom)) |
| 642 (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) | 648 (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) |
| 643 mouse-secondary-overlay start-point))))))))) | 649 mouse-secondary-overlay start-point))))))))) |
| 644 | 650 |
| 645 (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click) | 651 (if (consp event) |
| 646 (eq (posn-window (event-end event)) start-window) | 652 ;;; (eq (get (event-basic-type event) 'event-kind) 'mouse-click) |
| 647 (numberp (posn-point (event-end event)))) | 653 ;;; (eq (posn-window (event-end event)) start-window) |
| 654 ;;; (numberp (posn-point (event-end event))) | |
| 648 (if (marker-position mouse-secondary-start) | 655 (if (marker-position mouse-secondary-start) |
| 649 (save-window-excursion | 656 (save-window-excursion |
| 650 (delete-overlay mouse-secondary-overlay) | 657 (delete-overlay mouse-secondary-overlay) |
| 651 (x-set-selection 'SECONDARY nil) | 658 (x-set-selection 'SECONDARY nil) |
| 652 (select-window start-window) | 659 (select-window start-window) |