1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-05 08:53:45 +00:00
emacs/lisp/mouse-drag.el

325 lines
12 KiB
EmacsLisp
Raw Normal View History

;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling -*- lexical-binding: t -*-
1997-04-20 07:33:52 +00:00
;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
1996-09-25 03:30:55 +00:00
1996-09-25 03:35:44 +00:00
;; Author: John Heidemann <johnh@ISI.EDU>
;; Keywords: mouse
1996-09-25 03:30:55 +00:00
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
1996-09-25 03:30:55 +00:00
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
1996-09-25 03:30:55 +00:00
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
1996-09-25 03:30:55 +00:00
;;; Commentary:
;; What is ``mouse-drag.el''?
;;
;; Doesn't that scroll bar seem far away when you want to scroll?
;; This module overloads mouse-2 to do ``throw'' scrolling. You
;; click and drag. The distance you move from your original click
;; turns into a scroll amount. The scroll amount is scaled
;; exponentially to make both large moves and short adjustments easy.
;; What this boils down to is that you can easily scroll around the
;; buffer without much mouse movement. Finally, clicks which aren't
;; drags are passed off to the old mouse-2 binding, so old mouse-2
;; operations (find-file in dired-mode, yanking in most other modes)
;; still work.
;;
;; There is an alternative way to scroll, ``drag'' scrolling. You
;; can click on a character and then drag it around, scrolling the
;; buffer with you. The character always stays under the mouse.
;; Compared to throw-scrolling, this approach provides direct
;; manipulation (nice) but requires more mouse movement
;; (unfortunate). It is offered as an alternative for those who
;; prefer it.
;;
;; If you like mouse-drag, you should also check out mouse-copy
;; for ``one-click text copy and move''.
;;
Update docstrings and comments to use "init file" terminology. * bookmark.el (bookmark-bmenu-toggle-filenames): Doc fixes. * comint.el (comint-prompt-read-only): * custom.el (defcustom): * hi-lock.el (hi-lock-mode): * ibuffer.el (ibuffer-formats): * ielm.el (ielm-prompt-read-only): * novice.el (disable-command): * saveplace.el (toggle-save-place): * speedbar.el (speedbar-supported-extension-expressions): * startup.el (auto-save-list-file-prefix, init-file-user) (after-init-hook, inhibit-startup-echo-area-message): * strokes.el (strokes-help): * time-stamp.el (time-stamp): * calendar/calendar.el (calendar, diary-file): * calendar/diary-lib.el (diary-mail-entries, diary) (diary-list-entries-hook): * calendar/holidays.el (holidays, calendar-holidays): * calendar/lunar.el (lunar-phases): * calendar/solar.el (sunrise-sunset): * emulation/edt.el (edt-load-keys): * emulation/viper.el (viper-mode): * eshell/em-alias.el (eshell-command-aliases-list): * eshell/esh-util.el (eshell-convert-numeric-arguments): * international/ogonek.el (ogonek-information): * net/tramp-cmds.el (tramp-bug): * net/quickurl.el (quickurl-reread-hook-postfix): * play/decipher.el (decipher-font-lock-keywords): * progmodes/cc-styles.el (c-set-style): * progmodes/idlw-shell.el (idlwave-shell-prompt-pattern): * progmodes/inf-lisp.el (inferior-lisp-prompt): * progmodes/octave-mod.el (octave-mode): * progmodes/sql.el (sql-mode, sql-interactive-mode, sql-password): * progmodes/verilog-mode.el (verilog-read-defines): * textmodes/two-column.el (2C-mode): Likewise.
2012-09-17 05:41:04 +00:00
;; To use mouse-drag, place the following in your init file:
;; -either-
;; (global-set-key [down-mouse-2] 'mouse-drag-throw)
;; -or-
;; (global-set-key [down-mouse-2] 'mouse-drag-drag)
;;
;;
;;
;; Options:
;;
;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar]
;; - work around a bug with \\[mouse-extras-work-around-drag-bug]
;; - auto-enable horizontal scrolling with
;; \\[mouse-drag-electric-col-scrolling]
;;
;;
;; History and related work:
;;
;; One-click copying and moving was inspired by lemacs-19.8.
;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's
;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler
;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but
;; doesn't pass clicks through.
;;
;; Originally mouse-drag was part of a larger package.
;; As of 11 July 96 the scrolling functions were split out
;; in preparation for incorporation into (the future) emacs-19.32.
;;
;; Thanks:
;;
;; Thanks to Kai Grossjohann
;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to
;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and
;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for
;; prompting me to do drag-scrolling and for an initial
;; implementation of horizontal drag-scrolling.
;;
;; -johnh@isi.edu, 11-Jul-96
;;
;;
;; What's new with mouse-drag 2.24?
;;
;; - mouse-drag-electric-col-scrolling (default: on)
;; auto-enables horizontal scrolling when clicks on wrapped
;; lines occur
;; TODO:
;; - For mouse-drag-throw, we should try and place some visual indicator
;; of the original mouse position (like Firefox does).
1996-09-25 03:30:55 +00:00
;;; Code:
;;
;; scrolling code
;;
(defun mouse-drag-safe-scroll (row-delta &optional col-delta)
"Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors.
1996-09-25 03:30:55 +00:00
Keep the cursor on the screen as needed."
(let ((scroll-preserve-screen-position nil))
(if (and row-delta
(/= 0 row-delta))
(condition-case nil ;; catch and ignore movement errors
(scroll-down row-delta)
(beginning-of-buffer (message "Beginning of buffer"))
(end-of-buffer (message "End of buffer"))))
(if (and col-delta
(/= 0 col-delta))
(progn
(scroll-right col-delta)
;; Make sure that the point stays on the visible screen
;; (if truncation-lines in set).
;; This code mimics the behavior we automatically get
;; when doing vertical scrolling.
;; Problem identified and a fix suggested by Tom Wurgler.
(cond
((< (current-column) (window-hscroll))
(move-to-column (window-hscroll))) ; make on left column
((> (- (current-column) (window-hscroll) (window-width) -2) 0)
(move-to-column (+ (window-width) (window-hscroll) -3))))))))
1996-09-25 03:30:55 +00:00
(defun mouse-drag-repeatedly-safe-scroll (row-delta &optional col-delta)
"Scroll ROW-DELTA rows and COL-DELTA cols until an event happens."
1996-09-25 03:30:55 +00:00
(while (sit-for mouse-scroll-delay)
(mouse-drag-safe-scroll row-delta col-delta)))
(defun mouse-drag-events-are-point-events-p (start-posn end-posn)
"Determine if START-POSN and END-POSN are \"close\"."
1996-09-25 03:30:55 +00:00
(let*
((start-col-row (posn-col-row start-posn))
(end-col-row (posn-col-row end-posn)))
(and
;; ;; We no longer exclude things by time.
;; (< (- (posn-timestamp end-posn) (posn-timestamp start-posn))
;; (if (numberp double-click-time)
;; (* 2 double-click-time) ;; stretch it a little
;; 999999)) ;; non-numeric => check by position alone
1996-09-25 03:30:55 +00:00
(= (car start-col-row) (car end-col-row))
(= (cdr start-col-row) (cdr end-col-row)))))
(defvar mouse-drag-electric-col-scrolling t
"If non-nil, mouse-drag on a long line enables truncate-lines.")
1996-09-25 03:30:55 +00:00
(defun mouse-drag-should-do-col-scrolling ()
"Determine if it's wise to enable col-scrolling for the current window.
Basically, we check for existing horizontal scrolling."
1996-09-25 03:30:55 +00:00
(or truncate-lines
Do not call to `selected-window' where it is assumed by default. Affected functions are `window-minibuffer-p', `window-dedicated-p', `window-hscroll', `window-width', `window-height', `window-buffer', `window-frame', `window-start', `window-point', `next-window' and `window-display-table'. * abbrev.el (abbrev--default-expand): * bs.el (bs--show-with-configuration): * buff-menu.el (Buffer-menu-mouse-select): * calc/calc.el (calc): * calendar/calendar.el (calendar-generate-window): * calendar/diary-lib.el (diary-simple-display, diary-show-all-entries) (diary-make-entry): * comint.el (send-invisible, comint-dynamic-complete-filename) (comint-dynamic-simple-complete, comint-dynamic-list-completions): * completion.el (complete): * dabbrev.el (dabbrev-expand, dabbrev--make-friend-buffer-list): * disp-table.el (describe-current-display-table): * doc-view.el (doc-view-insert-image): * ebuff-menu.el (Electric-buffer-menu-mouse-select): * ehelp.el (with-electric-help): * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): * emacs-lisp/edebug.el (edebug-two-window-p, edebug-pop-to-buffer): * emacs-lisp/helper.el (Helper-help-scroller): * emulation/cua-base.el (cua--post-command-handler-1): * eshell/esh-mode.el (eshell-output-filter): * ffap.el (ffap-gnus-wrapper): * help-macro.el (make-help-screen): * hilit-chg.el (highlight-compare-buffers): * hippie-exp.el (hippie-expand, try-expand-dabbrev-visible): * hl-line.el (global-hl-line-highlight): * icomplete.el (icomplete-simple-completing-p): * isearch.el (isearch-done): * jit-lock.el (jit-lock-stealth-fontify): * mail/rmailsum.el (rmail-summary-scroll-msg-up): * lisp/mouse-drag.el (mouse-drag-should-do-col-scrolling): * mpc.el (mpc-tagbrowser, mpc): * net/rcirc.el (rcirc-any-buffer): * play/gomoku.el (gomoku-max-width, gomoku-max-height): * play/landmark.el (landmark-max-width, landmark-max-height): * play/zone.el (zone): * progmodes/compile.el (compilation-goto-locus): * progmodes/ebrowse.el (ebrowse-view/find-file-and-search-pattern): * progmodes/etags.el (find-tag-other-window): * progmodes/fortran.el (fortran-column-ruler): * progmodes/gdb-mi.el (gdb-mouse-toggle-breakpoint-fringe): * progmodes/verilog-mode.el (verilog-point-text): * reposition.el (reposition-window): * rot13.el (toggle-rot13-mode): * server.el (server-switch-buffer): * shell.el (shell-dynamic-complete-command) (shell-dynamic-complete-environment-variable): * simple.el (insert-buffer, set-selective-display) (delete-completion-window): * speedbar.el (speedbar-timer-fn, speedbar-center-buffer-smartly) (speedbar-recenter): * startup.el (fancy-splash-head): * textmodes/ispell.el (ispell-command-loop): * textmodes/makeinfo.el (makeinfo-compilation-sentinel-region): * tutorial.el (help-with-tutorial): * vc/add-log.el (add-change-log-entry): * vc/compare-w.el (compare-windows): * vc/ediff-help.el (ediff-indent-help-message): * vc/ediff-util.el (ediff-setup-control-buffer, ediff-position-region): * vc/ediff-wind.el (ediff-skip-unsuitable-frames) (ediff-setup-control-frame): * vc/emerge.el (emerge-position-region): * vc/pcvs-util.el (cvs-bury-buffer): * window.el (walk-windows, mouse-autoselect-window-select): * winner.el (winner-set-conf, winner-undo): Related users changed.
2013-08-05 14:26:57 +00:00
(> (window-hscroll) 0)
(not (window-full-width-p))
(and
mouse-drag-electric-col-scrolling
(save-excursion ;; on a long line?
(let
Replace still more end-of-line etc with line-end-position, etc. * lisp/gnus/nnbabyl.el (nnbabyl-request-move-article, nnbabyl-delete-mail) (nnbabyl-check-mbox): Use point-at-bol. * lisp/cedet/semantic/lex.el (semantic-lex-ignore-comments, semantic-flex): * lisp/cedet/semantic/grammar.el (semantic-grammar-epilogue): * lisp/cedet/ede/speedbar.el (ede-find-nearest-file-line): * lisp/cedet/ede/pmake.el (ede-proj-makefile-insert-dist-rules): * lisp/cedet/ede/autoconf-edit.el (autoconf-delete-parameter): Use point-at-bol and point-at-eol. * lisp/vc/emerge.el (emerge-line-number-in-buf): * lisp/textmodes/ispell.el (ispell-region): * lisp/textmodes/fill.el (current-fill-column): * lisp/progmodes/xscheme.el (xscheme-send-current-line): * lisp/progmodes/vhdl-mode.el (vhdl-current-line, vhdl-line-copy): * lisp/progmodes/tcl.el (tcl-hairy-scan-for-comment): * lisp/progmodes/sh-script.el (sh-handle-prev-do): * lisp/progmodes/meta-mode.el (meta-indent-line): * lisp/progmodes/idlwave.el (idlwave-goto-comment, idlwave-fill-paragraph) (idlwave-in-quote): * lisp/progmodes/idlw-shell.el (idlwave-shell-current-frame) (idlwave-shell-update-bp-overlays, idlwave-shell-sources-filter): * lisp/progmodes/fortran.el (fortran-looking-at-if-then): * lisp/progmodes/etags.el (find-tag-in-order, etags-snarf-tag): * lisp/progmodes/cperl-mode.el (cperl-sniff-for-indent) (cperl-find-pods-heres): * lisp/progmodes/ada-mode.el (ada-get-current-indent, ada-narrow-to-defun): * lisp/net/quickurl.el (quickurl-list-insert): * lisp/net/ldap.el (ldap-search-internal): * lisp/net/eudc.el (eudc-expand-inline): * lisp/mail/sendmail.el (sendmail-send-it): * lisp/mail/mspools.el (mspools-visit-spool, mspools-get-spool-name): * lisp/emulation/viper-cmd.el (viper-paren-match, viper-backward-indent) (viper-brac-function): * lisp/calc/calc-yank.el (calc-do-grab-region): * lisp/calc/calc-keypd.el (calc-keypad-press): * lisp/term.el (term-move-columns, term-insert-spaces): * lisp/speedbar.el (speedbar-highlight-one-tag-line): * lisp/simple.el (current-word): * lisp/mouse-drag.el (mouse-drag-should-do-col-scrolling): * lisp/info.el (Info-find-node-in-buffer-1, Info-follow-reference) (Info-scroll-down): * lisp/hippie-exp.el (he-line-beg): * lisp/epa.el (epa--marked-keys): * lisp/dired-aux.el (dired-kill-line, dired-do-kill-lines) (dired-update-file-line, dired-add-entry, dired-remove-entry) (dired-relist-entry): * lisp/buff-menu.el (Buffer-menu-buffer): * lisp/array.el (current-line): * lisp/allout.el (allout-resolve-xref) (allout-latex-verbatim-quote-curr-line): Replace yet more uses of end-of-line etc with line-end-position.
2010-11-09 05:33:07 +00:00
((beg (line-beginning-position))
(end (progn (end-of-line) (point))))
(if (> (- end beg) (window-width))
(setq truncate-lines t)
nil))))))
1996-09-25 03:30:55 +00:00
(defvar mouse-throw-with-scroll-bar nil
"Set direction of mouse-throwing.
1996-09-25 03:30:55 +00:00
If nil, the text moves in the direction the mouse moves.
If t, the scroll bar moves in the direction the mouse moves.")
(defconst mouse-throw-magnifier-min -6)
(defconst mouse-throw-magnifier-max 6)
(defconst mouse-throw-magnifier-base 1.5)
(defun mouse-drag-scroll-delta (mouse-delta)
;; Limit the exponential explosion.
(setq mouse-delta
(max mouse-throw-magnifier-min
(min mouse-throw-magnifier-max mouse-delta)))
(* (round (exp (* (log mouse-throw-magnifier-base) (abs mouse-delta))))
(if (< mouse-delta 0) -1 1)
(if mouse-throw-with-scroll-bar 1 -1)))
;;;###autoload
1996-09-25 03:30:55 +00:00
(defun mouse-drag-throw (start-event)
"\"Throw\" the page according to a mouse drag.
A \"throw\" is scrolling the page at a speed relative to the distance
from the original mouse click to the current mouse location. Try it;
you'll like it. It's easier to observe than to explain.
If the mouse is clicked and released in the same place of time we
assume that the user didn't want to scroll but wanted to whatever
1996-09-25 03:30:55 +00:00
mouse-2 used to do, so we pass it through.
Throw scrolling was inspired (but is not identical to) the \"hand\"
option in MacPaint, or the middle button in Tk text widgets.
If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls
in the opposite direction. (Different people have different ideas
about which direction is natural. Perhaps it has to do with which
hemisphere you're in.)
To test this function, evaluate:
(global-set-key [down-mouse-2] \\='mouse-drag-throw)"
1996-09-25 03:30:55 +00:00
(interactive "e")
;; we want to do save-selected-window, but that requires 19.29
(let* ((start-posn (event-start start-event))
(start-window (posn-window start-posn))
(start-row (cdr (posn-col-row start-posn)))
(start-col (car (posn-col-row start-posn)))
(old-selected-window (selected-window))
2011-04-19 13:44:55 +00:00
event end row scroll-delta
have-scrolled
2011-04-19 13:44:55 +00:00
col
1996-09-25 03:30:55 +00:00
(scroll-col-delta 0)
;; be conservative about allowing horizontal scrolling
(col-scrolling-p (mouse-drag-should-do-col-scrolling)))
(select-window start-window)
(track-mouse
;; Don't change the mouse pointer shape while we drag.
(setq track-mouse 'dragging)
1996-09-25 03:30:55 +00:00
(while (progn
Make libraries works with xterm-mouse-mode. Change calls from 'read-event' to 'read-key' in libraries expecting mouse events. Do this only when 'xterm-mouse-mode' is enabled. That way those libraries read decoded mouse events instead of the underlying escape sequence. Add a parameter to 'read-key' that avoids running any of the unbound fallbacks in 'read-key-sequence' so the libraries can read mouse button-down events. For backward compatibility purposes, the above logic is contained in a new internal-only function: 'read--potential-mouse-event'. * doc/lispref/commands.texi (Reading One Event): Document new parameter to 'read-key'. Mention that non-character events on terminals need 'read-key'. * lisp/subr.el (read-key-full-map): Add new keymap used by 'read-key'. (read-key): Add new parameter 'fallbacks-disabled' to prevent running any of the unbound fallbacks normally run by 'read-key-sequence'. (read--potential-mouse-event): Add new function that calls 'read-key' or 'read-event' depending on if 'xterm-mouse-mode' is set. * lisp/foldout.el (foldout-mouse-swallow-events): * lisp/isearch.el (isearch-pre-command-hook): * lisp/mouse-drag.el (mouse-drag-throw, mouse-drag-drag): * lisp/mouse.el (mouse-drag-secondary): * lisp/ruler-mode.el (ruler-mode-mouse-grab-any-column) (ruler-mode-mouse-drag-any-column-iteration): * lisp/strokes.el (strokes-read-stroke, strokes-read-complex-stroke): * lisp/textmodes/artist.el (artist-mouse-draw-continously) (artist-mouse-draw-poly, artist-mouse-draw-2points): * lisp/vc/ediff-wind.el (ediff-get-window-by-clicking): * lisp/wid-edit.el (widget-button--check-and-call-button) (widget-button-click): Call 'read--potential-mouse-event' instead of 'read-event'. * lisp/wid-edit.el (widget-key-sequence-read-event): Call 'read-key' with 'fallbacks-disabled' set instead of 'read-event'. Unlike above changes, this is unconditionally applied so it works for function keys too. Apply 'local-function-key-map' instead of 'function-key-map' as that contains the full terminal translations. * lisp/vc/ediff.el (ediff-windows): Use 'display-mouse-p' to check if a mouse is available. * src/lread.c (Fread_event): Recommend 'read-key' in docstring for 'read-event' for non-character events.
2021-01-02 22:10:17 +00:00
(setq event (read--potential-mouse-event)
1996-09-25 03:30:55 +00:00
end (event-end event)
row (cdr (posn-col-row end))
col (car (posn-col-row end)))
(or (mouse-movement-p event)
(eq (car-safe event) 'switch-frame)))
(when (eq start-window (posn-window end))
(when col-scrolling-p
(setq scroll-col-delta (mouse-drag-scroll-delta (- start-col col))))
(setq scroll-delta (mouse-drag-scroll-delta (- start-row row))))
1996-09-25 03:30:55 +00:00
(if (or (/= 0 scroll-delta)
(/= 0 scroll-col-delta))
(progn
(setq have-scrolled t)
(mouse-drag-safe-scroll scroll-delta scroll-col-delta)
(mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx
;; If it was a click and not a drag, prepare to pass the event on.
;; Is there a more correct way to reconstruct the event?
1996-09-25 03:30:55 +00:00
(if (and (not have-scrolled)
(mouse-drag-events-are-point-events-p start-posn end))
(push (cons (event-basic-type start-event) (cdr start-event))
unread-command-events))
1996-09-25 03:30:55 +00:00
;; Now restore the old window.
(select-window old-selected-window)))
1996-09-25 03:30:55 +00:00
;;;###autoload
1996-09-25 03:30:55 +00:00
(defun mouse-drag-drag (start-event)
"\"Drag\" the page according to a mouse drag.
Drag scrolling moves the page according to the movement of the mouse.
You \"grab\" the character under the mouse and move it around.
If the mouse is clicked and released in the same place of time we
assume that the user didn't want to scroll but wanted to whatever
mouse-2 used to do, so we pass it through.
Drag scrolling is identical to the \"hand\" option in MacPaint, or the
middle button in Tk text widgets.
To test this function, evaluate:
(global-set-key [down-mouse-2] \\='mouse-drag-drag)"
1996-09-25 03:30:55 +00:00
(interactive "e")
;; we want to do save-selected-window, but that requires 19.29
(let* ((start-posn (event-start start-event))
(start-window (posn-window start-posn))
(start-row (cdr (posn-col-row start-posn)))
(start-col (car (posn-col-row start-posn)))
(old-selected-window (selected-window))
2011-04-19 13:44:55 +00:00
event end row scroll-delta
have-scrolled
1996-09-25 03:30:55 +00:00
window-last-row
2011-04-19 13:44:55 +00:00
col window-last-col
1996-09-25 03:30:55 +00:00
(scroll-col-delta 0)
;; be conservative about allowing horizontal scrolling
(col-scrolling-p (mouse-drag-should-do-col-scrolling)))
(select-window start-window)
(setq window-last-row (- (window-height) 2)
window-last-col (- (window-width) 2))
(track-mouse
(while (progn
Make libraries works with xterm-mouse-mode. Change calls from 'read-event' to 'read-key' in libraries expecting mouse events. Do this only when 'xterm-mouse-mode' is enabled. That way those libraries read decoded mouse events instead of the underlying escape sequence. Add a parameter to 'read-key' that avoids running any of the unbound fallbacks in 'read-key-sequence' so the libraries can read mouse button-down events. For backward compatibility purposes, the above logic is contained in a new internal-only function: 'read--potential-mouse-event'. * doc/lispref/commands.texi (Reading One Event): Document new parameter to 'read-key'. Mention that non-character events on terminals need 'read-key'. * lisp/subr.el (read-key-full-map): Add new keymap used by 'read-key'. (read-key): Add new parameter 'fallbacks-disabled' to prevent running any of the unbound fallbacks normally run by 'read-key-sequence'. (read--potential-mouse-event): Add new function that calls 'read-key' or 'read-event' depending on if 'xterm-mouse-mode' is set. * lisp/foldout.el (foldout-mouse-swallow-events): * lisp/isearch.el (isearch-pre-command-hook): * lisp/mouse-drag.el (mouse-drag-throw, mouse-drag-drag): * lisp/mouse.el (mouse-drag-secondary): * lisp/ruler-mode.el (ruler-mode-mouse-grab-any-column) (ruler-mode-mouse-drag-any-column-iteration): * lisp/strokes.el (strokes-read-stroke, strokes-read-complex-stroke): * lisp/textmodes/artist.el (artist-mouse-draw-continously) (artist-mouse-draw-poly, artist-mouse-draw-2points): * lisp/vc/ediff-wind.el (ediff-get-window-by-clicking): * lisp/wid-edit.el (widget-button--check-and-call-button) (widget-button-click): Call 'read--potential-mouse-event' instead of 'read-event'. * lisp/wid-edit.el (widget-key-sequence-read-event): Call 'read-key' with 'fallbacks-disabled' set instead of 'read-event'. Unlike above changes, this is unconditionally applied so it works for function keys too. Apply 'local-function-key-map' instead of 'function-key-map' as that contains the full terminal translations. * lisp/vc/ediff.el (ediff-windows): Use 'display-mouse-p' to check if a mouse is available. * src/lread.c (Fread_event): Recommend 'read-key' in docstring for 'read-event' for non-character events.
2021-01-02 22:10:17 +00:00
(setq event (read--potential-mouse-event)
1996-09-25 03:30:55 +00:00
end (event-end event)
row (cdr (posn-col-row end))
col (car (posn-col-row end)))
(or (mouse-movement-p event)
(eq (car-safe event) 'switch-frame)))
;; Scroll if see if we're on the edge.
;; FIXME: should handle mouse-in-other window.
1996-09-25 03:30:55 +00:00
(cond
((not (eq start-window (posn-window end)))
t) ; wait for return to original window
((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0))
((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0))
((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1))
((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1))
(t
(setq scroll-delta (- row start-row)
start-row row)
(if col-scrolling-p
(setq scroll-col-delta (- col start-col)
start-col col))
(if (or (/= 0 scroll-delta)
(/= 0 scroll-col-delta))
(progn
(setq have-scrolled t)
(mouse-drag-safe-scroll scroll-delta scroll-col-delta)))))))
;; If it was a click and not a drag, prepare to pass the event on.
;; Is there a more correct way to reconstruct the event?
1996-09-25 03:30:55 +00:00
(if (and (not have-scrolled)
(mouse-drag-events-are-point-events-p start-posn end))
(push (cons (event-basic-type start-event) (cdr start-event))
unread-command-events))
1996-09-25 03:30:55 +00:00
;; Now restore the old window.
(select-window old-selected-window)))
1996-09-25 03:30:55 +00:00
(provide 'mouse-drag)
;;; mouse-drag.el ends here