mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00
Code Issues Releases Activity

(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.

Browse Source 
(mouse-drag-region, mouse-drag-secondary): Accept any list event
as normal termination of the dragging.
This commit is contained in:
Richard M. Stallman 1994-06-19 18:04:35 +00:00
parent 3ef1da4719
commit 4e399a5322
1 changed files with 41 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
lisp/mouse.el
View File

@ -162,23 +162,30 @@ Setting this to zero causes Emacs to scroll as fast as it can.")
If OVERLAY is an overlay, let it stretch from START to the far edge of If OVERLAY is an overlay, let it stretch from START to the far edge of
the newly visible text. the newly visible text.
Upon exit, point is at the far edge of the newly visible text." Upon exit, point is at the far edge of the newly visible text."
(while (progn (let ((opoint (point)))
(goto-char (window-start window)) (while (progn
(if (not (zerop (vertical-motion jump window))) (goto-char (window-start window))
(progn (if (not (zerop (vertical-motion jump window)))
(set-window-start window (point)) (progn
(if (natnump jump) (set-window-start window (point))
(progn (if (natnump jump)
(goto-char (window-end window)) (progn
;; window-end doesn't reflect the window's new (goto-char (window-end window))
;; start position until the next redisplay. Hurrah. ;; window-end doesn't reflect the window's new
(vertical-motion (1- jump) window)) ;; start position until the next redisplay. Hurrah.
(goto-char (window-start window))) (vertical-motion (1- jump) window))
(if overlay (goto-char (window-start window)))
(move-overlay overlay start (point))) (if overlay
(if (not (eobp)) (move-overlay overlay start (point)))
(sit-for mouse-scroll-delay)))))) ;; Now that we have scrolled WINDOW properly,
(point)) ;; put point back where it was for the redisplay
;; so that we don't mess up the selected window.
(or (eq window (selected-window))
(goto-char opoint))
(if (not (eobp))
(sit-for mouse-scroll-delay))))))
(or (eq window (selected-window))
(goto-char opoint))))
(defvar mouse-drag-overlay (make-overlay 1 1)) (defvar mouse-drag-overlay (make-overlay 1 1))
(overlay-put mouse-drag-overlay 'face 'region) (overlay-put mouse-drag-overlay 'face 'region)
@ -244,22 +251,21 @@ release the mouse button. Otherwise, it does not."
(>= mouse-row bottom)) (>= mouse-row bottom))
(mouse-scroll-subr start-window (1+ (- mouse-row bottom)) (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
mouse-drag-overlay start-point))))))))) mouse-drag-overlay start-point)))))))))
(if (consp event)
(if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click) ;;; When we scroll into the mode line or menu bar, or out of the window,
(eq (posn-window (event-end event)) start-window) ;;; we get events that don't fit these criteria.
(numberp (posn-point (event-end event)))) ;;; (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
;;; (eq (posn-window (event-end event)) start-window)
;;; (numberp (posn-point (event-end event)))
(let ((fun (key-binding (vector (car event))))) (let ((fun (key-binding (vector (car event)))))
(if (memq fun '(mouse-set-region mouse-set-point)) (if (not (= (overlay-start mouse-drag-overlay)
(if (not (= (overlay-start mouse-drag-overlay) (overlay-end mouse-drag-overlay)))
(overlay-end mouse-drag-overlay))) (let (last-command)
(let (last-command) (push-mark (overlay-start mouse-drag-overlay) t t)
(push-mark (overlay-start mouse-drag-overlay) t t)
(goto-char (overlay-end mouse-drag-overlay))
(copy-region-as-kill (point) (mark t)))
(goto-char (overlay-end mouse-drag-overlay)) (goto-char (overlay-end mouse-drag-overlay))
(setq this-command 'mouse-set-point)) (copy-region-as-kill (point) (mark t)))
(if (fboundp fun) (goto-char (overlay-end mouse-drag-overlay))
(funcall fun event))))) (setq this-command 'mouse-set-point))))
(delete-overlay mouse-drag-overlay)))) (delete-overlay mouse-drag-overlay))))
;; Commands to handle xterm-style multiple clicks. ;; Commands to handle xterm-style multiple clicks.
@ -642,9 +648,10 @@ This must be bound to a button-down mouse event."
(mouse-scroll-subr start-window (1+ (- mouse-row bottom)) (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
mouse-secondary-overlay start-point))))))))) mouse-secondary-overlay start-point)))))))))
(if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click) (if (consp event)
(eq (posn-window (event-end event)) start-window) ;;; (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
(numberp (posn-point (event-end event)))) ;;; (eq (posn-window (event-end event)) start-window)
;;; (numberp (posn-point (event-end event)))
(if (marker-position mouse-secondary-start) (if (marker-position mouse-secondary-start)
(save-window-excursion (save-window-excursion
(delete-overlay mouse-secondary-overlay) (delete-overlay mouse-secondary-overlay)