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) |