;;; mouse.el --- window system-independent mouse support
-;; Copyright (C) 1993, 1994, 1995, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
-;; Keywords: hardware
+;; Keywords: hardware, mouse
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
"*If non-nil, mouse yank commands yank at point instead of at click."
:type 'boolean
:group 'mouse)
+
+(defcustom mouse-drag-copy-region t
+ "*If non-nil, mouse drag copies region to kill-ring."
+ :type 'boolean
+ :version "22.1"
+ :group 'mouse)
+
+(defcustom mouse-1-click-follows-link 450
+ "Non-nil means that clicking Mouse-1 on a link follows the link.
+
+With the default setting, an ordinary Mouse-1 click on a link
+performs the same action as Mouse-2 on that link, while a longer
+Mouse-1 click \(hold down the Mouse-1 button for more than 350
+milliseconds) performs the original Mouse-1 binding \(which
+typically sets point where you click the mouse).
+
+If value is an integer, the time elapsed between pressing and
+releasing the mouse button determines whether to follow the link
+or perform the normal Mouse-1 action (typically set point).
+The absolute numeric value specifices the maximum duration of a
+\"short click\" in milliseconds. A positive value means that a
+short click follows the link, and a longer click performs the
+normal action. A negative value gives the opposite behavior.
+
+If value is `double', a double click follows the link.
+
+Otherwise, a single Mouse-1 click unconditionally follows the link.
+
+Note that dragging the mouse never follows the link.
+
+This feature only works in modes that specifically identify
+clickable text as links, so it may not work with some external
+packages. See `mouse-on-link-p' for details."
+ :version "22.1"
+ :type '(choice (const :tag "Disabled" nil)
+ (const :tag "Double click" double)
+ (number :tag "Single click time limit" :value 350)
+ (other :tag "Single click" t))
+ :group 'mouse)
+
+(defcustom mouse-1-click-in-non-selected-windows t
+ "*If non-nil, a Mouse-1 click also follows links in non-selected windows.
+
+If nil, a Mouse-1 click on a link in a non-selected window performs
+the normal mouse-1 binding, typically selects the window and sets
+point at the click position."
+ :type 'boolean
+ :version "22.1"
+ :group 'mouse)
+
+
\f
;; Provide a mode-specific menu on a mouse button.
-(defun mouse-major-mode-menu (event prefix)
+(defun popup-menu (menu &optional position prefix)
+ "Popup the given menu and call the selected option.
+MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
+`x-popup-menu'.
+POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and defaults to
+ the current mouse position.
+PREFIX is the prefix argument (if any) to pass to the command."
+ (let* ((map (cond
+ ((keymapp menu) menu)
+ ((and (listp menu) (keymapp (car menu))) menu)
+ (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
+ (filter (when (symbolp map)
+ (plist-get (get map 'menu-prop) :filter))))
+ (if filter (funcall filter (symbol-function map)) map)))))
+ event cmd)
+ (unless position
+ (let ((mp (mouse-pixel-position)))
+ (setq position (list (list (cadr mp) (cddr mp)) (car mp)))))
+ ;; The looping behavior was taken from lmenu's popup-menu-popup
+ (while (and map (setq event
+ ;; map could be a prefix key, in which case
+ ;; we need to get its function cell
+ ;; definition.
+ (x-popup-menu position (indirect-function map))))
+ ;; Strangely x-popup-menu returns a list.
+ ;; mouse-major-mode-menu was using a weird:
+ ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
+ (setq cmd
+ (if (and (not (keymapp map)) (listp map))
+ ;; We were given a list of keymaps. Search them all
+ ;; in sequence until a first binding is found.
+ (let ((mouse-click (apply 'vector event))
+ binding)
+ (while (and map (null binding))
+ (setq binding (lookup-key (car map) mouse-click))
+ (if (numberp binding) ; `too long'
+ (setq binding nil))
+ (setq map (cdr map)))
+ binding)
+ ;; We were given a single keymap.
+ (lookup-key map (apply 'vector event))))
+ ;; Clear out echoing, which perhaps shows a prefix arg.
+ (message "")
+ ;; Maybe try again but with the submap.
+ (setq map (if (keymapp cmd) cmd)))
+ ;; If the user did not cancel by refusing to select,
+ ;; and if the result is a command, run it.
+ (when (and (null map) (commandp cmd))
+ (setq prefix-arg prefix)
+ ;; `setup-specified-language-environment', for instance,
+ ;; expects this to be set from a menu keymap.
+ (setq last-command-event (car (last event)))
+ ;; mouse-major-mode-menu was using `command-execute' instead.
+ (call-interactively cmd))))
+
+(defvar mouse-major-mode-menu-prefix) ; dynamically bound
+
+(defun mouse-major-mode-menu (event &optional prefix)
"Pop up a mode-specific menu of mouse commands.
Default to the Edit menu if the major mode doesn't define a menu."
;; Switch to the window clicked on, because otherwise
;; the mode's commands may not make sense.
(interactive "@e\nP")
;; Let the mode update its menus first.
- (run-hooks 'activate-menubar-hook)
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(let* (;; This is where mouse-major-mode-menu-prefix
;; returns the prefix we should use (after menu-bar).
;; It is either nil or (SOME-SYMBOL).
;; Keymap from which to inherit; may be null.
(ancestor (mouse-major-mode-menu-1
(and (current-local-map)
- (lookup-key (current-local-map) [menu-bar]))))
+ (local-key-binding [menu-bar]))))
;; Make a keymap in which our last command leads to a menu or
;; default to the edit menu.
(newmap (if ancestor
(make-sparse-keymap (concat mode-name " Mode"))
- menu-bar-edit-menu))
- result)
+ menu-bar-edit-menu)))
(if ancestor
;; Make our menu inherit from the desired keymap which we want
;; to display as the menu now.
(set-keymap-parent newmap ancestor))
- (setq result (x-popup-menu t (list newmap)))
- (if result
- (let ((command (key-binding
- (apply 'vector (append '(menu-bar)
- mouse-major-mode-menu-prefix
- result)))))
- ;; Clear out echoing, which perhaps shows a prefix arg.
- (message "")
- (if command
- (progn
- (setq prefix-arg prefix)
- (command-execute command)))))))
+ (popup-menu newmap event prefix)))
+
;; Compute and cache the equivalent keys in MENU and all its submenus.
;;;(defun mouse-major-mode-menu-compute-equiv-keys (menu)
(if (eq submap t)
menubar
(setq mouse-major-mode-menu-prefix (list (car submap)))
- (cdr (cdr submap))))))
+ (lookup-key menubar (vector (car submap)))))))
+
+(defun mouse-popup-menubar (event prefix)
+ "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
+The contents are the items that would be in the menu bar whether or
+not it is actually displayed."
+ (interactive "@e \nP")
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
+ (let* ((local-menu (and (current-local-map)
+ (lookup-key (current-local-map) [menu-bar])))
+ (global-menu (lookup-key global-map [menu-bar]))
+ ;; If a keymap doesn't have a prompt string (a lazy
+ ;; programmer didn't bother to provide one), create it and
+ ;; insert it into the keymap; each keymap gets its own
+ ;; prompt. This is required for non-toolkit versions to
+ ;; display non-empty menu pane names.
+ (minor-mode-menus
+ (mapcar
+ (function
+ (lambda (menu)
+ (let* ((minor-mode (car menu))
+ (menu (cdr menu))
+ (title-or-map (cadr menu)))
+ (or (stringp title-or-map)
+ (setq menu
+ (cons 'keymap
+ (cons (concat
+ (capitalize (subst-char-in-string
+ ?- ?\ (symbol-name
+ minor-mode)))
+ " Menu")
+ (cdr menu)))))
+ menu)))
+ (minor-mode-key-binding [menu-bar])))
+ (local-title-or-map (and local-menu (cadr local-menu)))
+ (global-title-or-map (cadr global-menu)))
+ (or (null local-menu)
+ (stringp local-title-or-map)
+ (setq local-menu (cons 'keymap
+ (cons (concat mode-name " Mode Menu")
+ (cdr local-menu)))))
+ (or (stringp global-title-or-map)
+ (setq global-menu (cons 'keymap
+ (cons "Global Menu"
+ (cdr global-menu)))))
+ ;; Supplying the list is faster than making a new map.
+ (popup-menu (append (list global-menu)
+ (if local-menu
+ (list local-menu))
+ minor-mode-menus)
+ event prefix)))
+
+(defun mouse-popup-menubar-stuff (event prefix)
+ "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
+Use the former if the menu bar is showing, otherwise the latter."
+ (interactive "@e \nP")
+ (if (zerop (assoc-default 'menu-bar-lines (frame-parameters) 'eq 0))
+ (mouse-popup-menubar event prefix)
+ (mouse-major-mode-menu event prefix)))
\f
;; Commands that operate on windows.
(defun mouse-delete-window (click)
"Delete the window you click on.
-If the frame has just one window, bury the current buffer instead.
+Do nothing if the frame has just one window.
This command must be bound to a mouse click."
(interactive "e")
- (if (one-window-p t)
- (bury-buffer)
+ (unless (one-window-p t)
(mouse-minibuffer-check click)
(delete-window (posn-window (event-start click)))))
(delete-window window)))
(defun mouse-delete-other-windows ()
- "Delete all window except the one you click on."
+ "Delete all windows except the one you click on."
(interactive "@")
(delete-other-windows))
(split-window-horizontally
(min (max new-width first-col) last-col))))))
-(defun mouse-drag-mode-line (start-event)
- "Change the height of a window by dragging on the mode line."
- (interactive "e")
+(defun mouse-drag-window-above (window)
+ "Return the (or a) window directly above WINDOW.
+That means one whose bottom edge is at the same height as WINDOW's top edge."
+ (let ((top (nth 1 (window-edges window)))
+ (start-window window)
+ above-window)
+ (setq window (previous-window window 0))
+ (while (and (not above-window) (not (eq window start-window)))
+ (if (= (+ (window-height window) (nth 1 (window-edges window)))
+ top)
+ (setq above-window window))
+ (setq window (previous-window window)))
+ above-window))
+
+(defun mouse-drag-move-window-bottom (window growth)
+ "Move the bottom of WINDOW up or down by GROWTH lines.
+Move it down if GROWTH is positive, or up if GROWTH is negative.
+If this would make WINDOW too short,
+shrink the window or windows above it to make room."
+ (let ((excess (- window-min-height (+ (window-height window) growth))))
+ ;; EXCESS is the number of lines we need to take from windows above.
+ (if (> excess 0)
+ ;; This can recursively shrink windows all the way up.
+ (let ((window-above (mouse-drag-window-above window)))
+ (if window-above
+ (mouse-drag-move-window-bottom window-above (- excess))))))
+ (save-selected-window
+ (select-window window)
+ (enlarge-window growth nil (> growth 0))))
+
+(defsubst mouse-drag-move-window-top (window growth)
+ "Move the top of WINDOW up or down by GROWTH lines.
+Move it down if GROWTH is positive, or up if GROWTH is negative.
+If this would make WINDOW too short, shrink the window or windows
+above it to make room."
+ ;; Moving the top of WINDOW is actually moving the bottom of the
+ ;; window above.
+ (let ((window-above (mouse-drag-window-above window)))
+ (and window-above
+ (mouse-drag-move-window-bottom window-above (- growth)))))
+
+(defun mouse-drag-mode-line-1 (start-event mode-line-p)
+ "Change the height of a window by dragging on the mode or header line.
+START-EVENT is the starting mouse-event of the drag action.
+MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
- (let ((done nil)
- (echo-keystrokes 0)
- (start-event-frame (window-frame (car (car (cdr start-event)))))
- (start-event-window (car (car (cdr start-event))))
- (start-nwindows (count-windows t))
- (old-selected-window (selected-window))
- should-enlarge-minibuffer
- event mouse minibuffer y top bot edges wconfig params growth)
- (setq params (frame-parameters))
- (setq minibuffer (cdr (assq 'minibuffer params)))
+ (let* ((done nil)
+ (echo-keystrokes 0)
+ (start (event-start start-event))
+ (start-event-window (posn-window start))
+ (start-event-frame (window-frame start-event-window))
+ (start-nwindows (count-windows t))
+ (old-selected-window (selected-window))
+ (minibuffer (frame-parameter nil 'minibuffer))
+ should-enlarge-minibuffer event mouse y top bot edges wconfig growth)
(track-mouse
(progn
;; enlarge-window only works on the selected window, so
;; we must select the window where the start event originated.
;; unwind-protect will restore the old selected window later.
(select-window start-event-window)
+
;; if this is the bottommost ordinary window, then to
;; move its modeline the minibuffer must be enlarged.
(setq should-enlarge-minibuffer
(and minibuffer
+ mode-line-p
(not (one-window-p t))
(= (nth 1 (window-edges minibuffer))
(nth 3 (window-edges)))))
+
;; loop reading events and sampling the position of
;; the mouse.
(while (not done)
(setq event (read-event)
mouse (mouse-position))
+
;; do nothing if
;; - there is a switch-frame event.
;; - the mouse isn't in the frame that we started in
;; unknown event.
(cond ((integerp event)
(setq done t))
- ((eq (car event) 'switch-frame)
+
+ ((memq (car event) '(switch-frame select-window))
nil)
- ((not (memq (car event)
- '(mouse-movement scroll-bar-movement)))
- (if (consp event)
- (setq unread-command-events
- (cons event unread-command-events)))
+
+ ((not (memq (car event) '(mouse-movement scroll-bar-movement)))
+ (when (consp event)
+ (push event unread-command-events))
(setq done t))
+
((not (eq (car mouse) start-event-frame))
nil)
+
((null (car (cdr mouse)))
nil)
+
(t
(setq y (cdr (cdr mouse))
edges (window-edges)
top (nth 1 edges)
bot (nth 3 edges))
- ;; scale back a move that would make the
- ;; window too short.
- (cond ((< (- y top -1) window-min-height)
- (setq y (+ top window-min-height -1))))
+
;; compute size change needed
- (setq growth (- y bot -1)
- wconfig (current-window-configuration))
+ (cond (mode-line-p
+ (setq growth (- y bot -1)))
+ (t ; header line
+ (when (< (- bot y) window-min-height)
+ (setq y (- bot window-min-height)))
+ ;; The window's top includes the header line!
+ (setq growth (- top y))))
+ (setq wconfig (current-window-configuration))
+
;; Check for an error case.
- (if (and (/= growth 0)
- (not minibuffer)
- (one-window-p t))
- (error "Attempt to resize sole window"))
+ (when (and (/= growth 0)
+ (not minibuffer)
+ (one-window-p t))
+ (error "Attempt to resize sole window"))
+
;; grow/shrink minibuffer?
(if should-enlarge-minibuffer
(progn
(enlarge-window (- growth))
(select-window start-event-window))
;; no. grow/shrink the selected window
- (enlarge-window growth))
+ ;(message "growth = %d" growth)
+ (if mode-line-p
+ (mouse-drag-move-window-bottom start-event-window growth)
+ (mouse-drag-move-window-top start-event-window growth)))
+
;; if this window's growth caused another
;; window to be deleted because it was too
;; short, rescind the change.
;;
;; if size change caused space to be stolen
;; from a window above this one, rescind the
- ;; change, but only if we didn't grow/srhink
+ ;; change, but only if we didn't grow/shrink
;; the minibuffer. minibuffer size changes
;; can cause all windows to shrink... no way
;; around it.
- (if (or (/= start-nwindows (count-windows t))
- (and (not should-enlarge-minibuffer)
- (/= top (nth 1 (window-edges)))))
- (set-window-configuration wconfig)))))))))
+ (when (or (/= start-nwindows (count-windows t))
+ (and (not should-enlarge-minibuffer)
+ (> growth 0)
+ mode-line-p
+ (/= top (nth 1 (window-edges)))))
+ (set-window-configuration wconfig)))))))))
+
+(defun mouse-drag-mode-line (start-event)
+ "Change the height of a window by dragging on the mode line."
+ (interactive "e")
+ (mouse-drag-mode-line-1 start-event t))
+
+(defun mouse-drag-header-line (start-event)
+ "Change the height of a window by dragging on the header line.
+Windows whose header-lines are at the top of the frame cannot be
+resized by dragging their header-line."
+ (interactive "e")
+ ;; Changing the window's size by dragging its header-line when the
+ ;; header-line is at the top of the frame is somewhat strange,
+ ;; because the header-line doesn't move, so don't do it.
+ (let* ((start (event-start start-event))
+ (window (posn-window start))
+ (frame (window-frame window))
+ (first-window (frame-first-window frame)))
+ (unless (or (eq window first-window)
+ (= (nth 1 (window-edges window))
+ (nth 1 (window-edges first-window))))
+ (mouse-drag-mode-line-1 start-event nil))))
+
\f
(defun mouse-drag-vertical-line (start-event)
"Change the width of a window by dragging on the vertical line."
;; unknown event.
(cond ((integerp event)
(setq done t))
- ((eq (car event) 'switch-frame)
+ ((memq (car event) '(switch-frame select-window))
nil)
((not (memq (car event)
'(mouse-movement scroll-bar-movement)))
(mouse-minibuffer-check event)
;; Use event-end in case called from mouse-drag-region.
;; If EVENT is a click, event-end and event-start give same value.
- (let ((posn (event-end event)))
- (if (not (windowp (posn-window posn)))
- (error "Cursor not in text area of window"))
- (select-window (posn-window posn))
- (if (numberp (posn-point posn))
- (goto-char (posn-point posn)))))
+ (posn-set-point (event-end event)))
(defvar mouse-last-region-beg nil)
(defvar mouse-last-region-end nil)
;; Don't set this-command to kill-region, so that a following
;; C-w will not double the text in the kill ring.
;; Ignore last-command so we don't append to a preceding kill.
- (let (this-command last-command deactivate-mark)
- (copy-region-as-kill (mark) (point)))
+ (when mouse-drag-copy-region
+ (let (this-command last-command deactivate-mark)
+ (copy-region-as-kill (mark) (point))))
(mouse-set-region-1)))
(defun mouse-set-region-1 ()
+ ;; Set transient-mark-mode for a little while.
+ (if (memq transient-mark-mode '(nil identity))
+ (setq transient-mark-mode 'only))
(setq mouse-last-region-beg (region-beginning))
(setq mouse-last-region-end (region-end))
(setq mouse-last-region-tick (buffer-modified-tick)))
Highlight the drag area as you move the mouse.
This must be bound to a button-down mouse event.
In Transient Mark mode, the highlighting remains as long as the mark
-remains active. Otherwise, it remains until the next input event."
+remains active. Otherwise, it remains until the next input event.
+
+If the click is in the echo area, display the `*Messages*' buffer."
(interactive "e")
+ (let ((w (posn-window (event-start start-event))))
+ (if (and (window-minibuffer-p w)
+ (not (minibuffer-window-active-p w)))
+ (save-excursion
+ ;; Swallow the up-event.
+ (read-event)
+ (set-buffer "*Messages*")
+ (goto-char (point-max))
+ (display-buffer (current-buffer)))
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (mouse-drag-region-1 start-event))))
+
+
+(defun mouse-on-link-p (pos)
+ "Return non-nil if POS is on a link in the current buffer.
+POS must be a buffer position in the current buffer or an mouse
+event location in the selected window, see `event-start'.
+However, if `mouse-1-click-in-non-selected-windows' is non-nil,
+POS may be a mouse event location in any window.
+
+A clickable link is identified by one of the following methods:
+
+- If the character at POS has a non-nil `follow-link' text or
+overlay property, the value of that property determines what to do.
+
+- If there is a local key-binding or a keybinding at position POS
+for the `follow-link' event, the binding of that event determines
+what to do.
+
+The resulting value determine whether POS is inside a link:
+
+- If the value is `mouse-face', POS is inside a link if there
+is a non-nil `mouse-face' property at POS. Return t in this case.
+
+- If the value is a function, FUNC, POS is inside a link if
+the call \(FUNC POS) returns non-nil. Return the return value
+from that call. Arg is \(posn-point POS) if POS is a mouse event,
+
+- Otherwise, return the value itself.
+
+The return value is interpreted as follows:
+
+- If it is a string, the mouse-1 event is translated into the
+first character of the string, i.e. the action of the mouse-1
+click is the local or global binding of that character.
+
+- If it is a vector, the mouse-1 event is translated into the
+first element of that vector, i.e. the action of the mouse-1
+click is the local or global binding of that event.
+
+- Otherwise, the mouse-1 event is translated into a mouse-2 event
+at the same position."
+ (let ((w (and (consp pos) (posn-window pos))))
+ (if (consp pos)
+ (setq pos (and (or mouse-1-click-in-non-selected-windows
+ (eq (selected-window) w))
+ (posn-point pos))))
+ (when pos
+ (with-current-buffer (window-buffer w)
+ (let ((action
+ (or (get-char-property pos 'follow-link)
+ (save-excursion
+ (goto-char pos)
+ (key-binding [follow-link] nil t)))))
+ (cond
+ ((eq action 'mouse-face)
+ (and (get-char-property pos 'mouse-face) t))
+ ((functionp action)
+ (funcall action pos))
+ (t action)))))))
+
+(defun mouse-fixup-help-message (msg)
+ "Fix help message MSG for `mouse-1-click-follows-link'."
+ (let (mp pos)
+ (if (and mouse-1-click-follows-link
+ (stringp msg)
+ (save-match-data
+ (string-match "^mouse-2" msg))
+ (setq mp (mouse-pixel-position))
+ (consp (setq pos (cdr mp)))
+ (car pos) (>= (car pos) 0)
+ (cdr pos) (>= (cdr pos) 0)
+ (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
+ (windowp (posn-window pos)))
+ (with-current-buffer (window-buffer (posn-window pos))
+ (if (mouse-on-link-p pos)
+ (setq msg (concat
+ (cond
+ ((eq mouse-1-click-follows-link 'double) "double-")
+ ((and (integerp mouse-1-click-follows-link)
+ (< mouse-1-click-follows-link 0)) "Long ")
+ (t ""))
+ "mouse-1" (substring msg 7)))))))
+ msg)
+
+(defun mouse-drag-region-1 (start-event)
(mouse-minibuffer-check start-event)
(let* ((echo-keystrokes 0)
(start-posn (event-start start-event))
(start-point (posn-point start-posn))
(start-window (posn-window start-posn))
+ (start-window-start (window-start start-window))
(start-frame (window-frame start-window))
+ (start-hscroll (window-hscroll start-window))
(bounds (window-edges start-window))
+ (make-cursor-line-fully-visible nil)
(top (nth 1 bounds))
(bottom (if (window-minibuffer-p start-window)
(nth 3 bounds)
;; Don't count the mode line.
(1- (nth 3 bounds))))
+ (on-link (and mouse-1-click-follows-link
+ (or mouse-1-click-in-non-selected-windows
+ (eq start-window (selected-window)))))
+ remap-double-click
(click-count (1- (event-click-count start-event))))
(setq mouse-selection-click-count click-count)
(setq mouse-selection-click-count-buffer (current-buffer))
(if (< (point) start-point)
(goto-char start-point))
(setq start-point (point))
+ (setq on-link (and on-link
+ (mouse-on-link-p start-point)))
+ (setq remap-double-click (and on-link
+ (eq mouse-1-click-follows-link 'double)
+ (= click-count 1)))
+ (if remap-double-click ;; Don't expand mouse overlay in links
+ (setq click-count 0))
(let ((range (mouse-start-end start-point start-point click-count)))
(move-overlay mouse-drag-overlay (car range) (nth 1 range)
- (window-buffer start-window)))
+ (window-buffer start-window))
+ (overlay-put mouse-drag-overlay 'window (selected-window)))
(deactivate-mark)
;; end-of-range is used only in the single-click case.
;; It is the place where the drag has reached so far
(while (progn
(setq event (read-event))
(or (mouse-movement-p event)
- (eq (car-safe event) 'switch-frame)))
- (if (eq (car-safe event) 'switch-frame)
+ (memq (car-safe event) '(switch-frame select-window))))
+ (if (memq (car-safe event) '(switch-frame select-window))
nil
(setq end (event-end event)
end-point (posn-point end))
(mouse-scroll-subr start-window (1+ (- mouse-row bottom))
mouse-drag-overlay start-point)
(setq end-of-range (overlay-end mouse-drag-overlay))))))))))
+
;; In case we did not get a mouse-motion event
;; for the final move of the mouse before a drag event
;; pretend that we did get one.
end-point (posn-point end))
(eq (posn-window end) start-window)
(integer-or-marker-p end-point))
-
;; Go to START-POINT first, so that when we move to END-POINT,
;; if it's in the middle of intangible text,
;; point jumps in the direction away from START-POINT.
(push-mark region-commencement t t)
(goto-char region-termination)
;; Don't let copy-region-as-kill set deactivate-mark.
- (let (deactivate-mark)
- (copy-region-as-kill (point) (mark t)))
+ (when mouse-drag-copy-region
+ (let (deactivate-mark)
+ (copy-region-as-kill (point) (mark t))))
(let ((buffer (current-buffer)))
(mouse-show-mark)
;; mouse-show-mark can call read-event,
;; and that means the Emacs server could switch buffers
- ;; under us. If that happened,
+ ;; under us. If that happened,
;; avoid trying to use the region.
(and (mark t) mark-active
(eq buffer (current-buffer))
(mouse-set-region-1))))
(delete-overlay mouse-drag-overlay)
;; Run the binding of the terminating up-event.
- (if (fboundp fun)
- (setq unread-command-events
- (cons event unread-command-events)))))
+ (when (and (functionp fun)
+ (= start-hscroll (window-hscroll start-window))
+ ;; Don't run the up-event handler if the
+ ;; window start changed in a redisplay after
+ ;; the mouse-set-point for the down-mouse
+ ;; event at the beginning of this function.
+ ;; When the window start has changed, the
+ ;; up-mouse event will contain a different
+ ;; position due to the new window contents,
+ ;; and point is set again.
+ (or end-point
+ (= (window-start start-window)
+ start-window-start)))
+ (if (and on-link
+ (or (not end-point) (= end-point start-point))
+ (consp event)
+ (or remap-double-click
+ (and
+ (not (eq mouse-1-click-follows-link 'double))
+ (= click-count 0)
+ (= (event-click-count event) 1)
+ (not (input-pending-p))
+ (or (not (integerp mouse-1-click-follows-link))
+ (let ((t0 (posn-timestamp (event-start start-event)))
+ (t1 (posn-timestamp (event-end event))))
+ (and (integerp t0) (integerp t1)
+ (if (> mouse-1-click-follows-link 0)
+ (<= (- t1 t0) mouse-1-click-follows-link)
+ (< (- t0 t1) mouse-1-click-follows-link)))))
+ (or (not double-click-time)
+ (sit-for 0 (if (integerp double-click-time)
+ double-click-time 500) t)))))
+ (if (or (vectorp on-link) (stringp on-link))
+ (setq event (aref on-link 0))
+ (setcar event 'mouse-2)))
+ (setq unread-command-events
+ (cons event unread-command-events)))))
(delete-overlay mouse-drag-overlay)))))
\f
;; Commands to handle xterm-style multiple clicks.
(while (and (not (eobp)) (= (following-char) char))
(forward-char 1))))))
-;; Return a list of region bounds based on START and END according to MODE.
-;; If MODE is 0 then set point to (min START END), mark to (max START END).
-;; If MODE is 1 then set point to start of word at (min START END),
-;; mark to end of word at (max START END).
-;; If MODE is 2 then do the same for lines.
(defun mouse-start-end (start end mode)
+"Return a list of region bounds based on START and END according to MODE.
+If MODE is 0 then set point to (min START END), mark to (max START END).
+If MODE is 1 then set point to start of word at (min START END),
+mark to end of word at (max START END).
+If MODE is 2 then do the same for lines."
(if (> start end)
(let ((temp start))
(setq start end
(= start end)
(char-after start)
(= (char-syntax (char-after start)) ?\)))
- (list (save-excursion
+ (list (save-excursion
(goto-char (1+ start))
(backward-sexp 1)
(point))
(list start
(save-excursion
(condition-case nil
- (progn
+ (progn
(goto-char start)
(forward-sexp 1)
(point))
(setcar last event)
nil)))
-;; Momentarily show where the mark is, if highlighting doesn't show it.
+;; Momentarily show where the mark is, if highlighting doesn't show it.
-(defvar mouse-region-delete-keys '([delete])
+(defvar mouse-region-delete-keys '([delete] [deletechar])
"List of keys which shall cause the mouse region to be deleted.")
(defun mouse-show-mark ()
- (if transient-mark-mode
- (if window-system
- (delete-overlay mouse-drag-overlay))
- (if window-system
- (let ((inhibit-quit t)
- (echo-keystrokes 0)
- event events key ignore
- x-lost-selection-hooks)
- (add-hook 'x-lost-selection-hooks
- '(lambda (seltype)
- (if (eq seltype 'PRIMARY)
- (progn (setq ignore t)
- (throw 'mouse-show-mark t)))))
- (move-overlay mouse-drag-overlay (point) (mark t))
- (catch 'mouse-show-mark
- ;; In this loop, execute scroll bar and switch-frame events.
- ;; Also ignore down-events that are undefined.
- (while (progn (setq event (read-event))
- (setq events (append events (list event)))
- (setq key (apply 'vector events))
- (or (and (consp event)
- (eq (car event) 'switch-frame))
- (and (consp event)
- (eq (posn-point (event-end event))
- 'vertical-scroll-bar))
- (and (memq 'down (event-modifiers event))
- (not (key-binding key))
- (not (mouse-undouble-last-event events))
- (not (member key mouse-region-delete-keys)))))
- (and (consp event)
- (or (eq (car event) 'switch-frame)
- (eq (posn-point (event-end event))
- 'vertical-scroll-bar))
- (let ((keys (vector 'vertical-scroll-bar event)))
- (and (key-binding keys)
- (progn
- (call-interactively (key-binding keys)
- nil keys)
- (setq events nil)))))))
- ;; If we lost the selection, just turn off the highlighting.
- (if ignore
- nil
- ;; For certain special keys, delete the region.
- (if (member key mouse-region-delete-keys)
- (delete-region (overlay-start mouse-drag-overlay)
- (overlay-end mouse-drag-overlay))
- ;; Otherwise, unread the key so it gets executed normally.
- (setq unread-command-events
- (nconc events unread-command-events))))
- (setq quit-flag nil)
- (delete-overlay mouse-drag-overlay))
- (save-excursion
- (goto-char (mark t))
- (sit-for 1)))))
+ (let ((inhibit-quit t)
+ (echo-keystrokes 0)
+ event events key ignore
+ (x-lost-selection-functions
+ (when (boundp 'x-lost-selection-functions)
+ (copy-sequence x-lost-selection-functions))))
+ (add-hook 'x-lost-selection-functions
+ (lambda (seltype)
+ (when (eq seltype 'PRIMARY)
+ (setq ignore t)
+ (throw 'mouse-show-mark t))))
+ (if transient-mark-mode
+ (delete-overlay mouse-drag-overlay)
+ (move-overlay mouse-drag-overlay (point) (mark t)))
+ (catch 'mouse-show-mark
+ ;; In this loop, execute scroll bar and switch-frame events.
+ ;; Should we similarly handle `select-window' events? --Stef
+ ;; Also ignore down-events that are undefined.
+ (while (progn (setq event (read-event))
+ (setq events (append events (list event)))
+ (setq key (apply 'vector events))
+ (or (and (consp event)
+ (eq (car event) 'switch-frame))
+ (and (consp event)
+ (eq (posn-point (event-end event))
+ 'vertical-scroll-bar))
+ (and (memq 'down (event-modifiers event))
+ (not (key-binding key))
+ (not (mouse-undouble-last-event events))
+ (not (member key mouse-region-delete-keys)))))
+ (and (consp event)
+ (or (eq (car event) 'switch-frame)
+ (eq (posn-point (event-end event))
+ 'vertical-scroll-bar))
+ (let ((keys (vector 'vertical-scroll-bar event)))
+ (and (key-binding keys)
+ (progn
+ (call-interactively (key-binding keys)
+ nil keys)
+ (setq events nil)))))))
+ ;; If we lost the selection, just turn off the highlighting.
+ (unless ignore
+ ;; For certain special keys, delete the region.
+ (if (member key mouse-region-delete-keys)
+ (delete-region (mark t) (point))
+ ;; Otherwise, unread the key so it gets executed normally.
+ (setq unread-command-events
+ (nconc events unread-command-events))))
+ (setq quit-flag nil)
+ (unless transient-mark-mode
+ (delete-overlay mouse-drag-overlay))))
(defun mouse-set-mark (click)
"Set mark at the position clicked on with the mouse.
(defun mouse-yank-at-click (click arg)
"Insert the last stretch of killed text at the position clicked on.
-Also move point to one end of the text thus inserted (normally the end).
+Also move point to one end of the text thus inserted (normally the end),
+and set mark at the beginning.
Prefix arguments are interpreted as with \\[yank].
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
;; Delete, but make the undo-list entry share with the kill ring.
;; First, delete just one char, so in case buffer is being modified
;; for the first time, the undo list records that fact.
- (let (before-change-function after-change-function
- before-change-functions after-change-functions)
+ (let (before-change-functions after-change-functions)
(delete-region beg
(+ beg (if (> end beg) 1 -1))))
(let ((buffer-undo-list buffer-undo-list))
;; Undo that deletion--but don't change the undo list!
- (let (before-change-function after-change-function
- before-change-functions after-change-functions)
+ (let (before-change-functions after-change-functions)
(primitive-undo 1 buffer-undo-list))
;; Now delete the rest of the specified region,
;; but don't record it.
If you have selected words or lines, this command extends the
selection through the word or line clicked on. If you do this
again in a different position, it extends the selection again.
-If you do this twice in the same position, the selection is killed."
+If you do this twice in the same position, the selection is killed."
(interactive "e")
(let ((before-scroll
(with-current-buffer (window-buffer (posn-window (event-start click)))
(set-buffer (window-buffer (posn-window (event-start click))))
(and (mark t) (> (mod mouse-selection-click-count 3) 0)
;; Don't be fooled by a recent click in some other buffer.
- (eq mouse-selection-click-count-buffer
+ (eq mouse-selection-click-count-buffer
(current-buffer)))))
(if (not (and (eq last-command 'mouse-save-then-kill)
(equal click-posn
(progn
;; Move whichever end of the region is closer to the click.
;; That is what xterm does, and it seems reasonable.
- (if (< (abs (- new (point))) (abs (- new (mark t))))
+ (if (<= (abs (- new (point))) (abs (- new (mark t))))
(goto-char new)
(set-mark new))
(setq deactivate-mark nil)))
(goto-char before-scroll))
(exchange-point-and-mark)
(kill-new (buffer-substring (point) (mark t)))
- (if window-system
- (mouse-show-mark)))
+ (mouse-show-mark))
(mouse-set-region-1)
(setq mouse-save-then-kill-posn
(list (car kill-ring) (point) click-posn)))))))
(while (progn
(setq event (read-event))
(or (mouse-movement-p event)
- (eq (car-safe event) 'switch-frame)))
+ (memq (car-safe event) '(switch-frame select-window))))
- (if (eq (car-safe event) 'switch-frame)
+ (if (memq (car-safe event) '(switch-frame select-window))
nil
(setq end (event-end event)
end-point (posn-point end))
click-posn))
(setq deactivate-mark nil)))
(if (eq last-command 'mouse-secondary-save-then-kill)
- ;; If the front of the kill ring comes from
+ ;; If the front of the kill ring comes from
;; an immediately previous use of this command,
;; replace it with the extended region.
;; (It would be annoying to make a separate entry.)
("ObjC" . "C")
("Text" . "Text")
("Outline" . "Text")
+ ("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML")
+ ("log\\|diff\\|vc\\|cvs" . "Version Control") ; "Change Management"?
("Lisp" . "Lisp"))
"How to group various major modes together in \\[mouse-buffer-menu].
Each element has the form (REGEXP . GROUPNAME).
(while (and split-by-major-mode
(and (> (length (car split-by-major-mode)) 3)
(> (* buffers-left 10) (length buffers))))
- (setq subdivided-menus
- (cons (cons
- (nth 1 (car split-by-major-mode))
- (mouse-buffer-menu-alist
- (cdr (cdr (car split-by-major-mode)))))
- subdivided-menus))
+ (let ((this-mode-list (mouse-buffer-menu-alist
+ (cdr (cdr (car split-by-major-mode))))))
+ (and this-mode-list
+ (setq subdivided-menus
+ (cons (cons
+ (nth 1 (car split-by-major-mode))
+ this-mode-list)
+ subdivided-menus))))
(setq buffers-left
(- buffers-left (length (cdr (car split-by-major-mode)))))
(setq split-by-major-mode (cdr split-by-major-mode)))
;; If any major modes are left over,
;; make a single submenu for them.
(if split-by-major-mode
- (setq subdivided-menus
- (cons (cons
- "Others"
- (mouse-buffer-menu-alist
- ;; we don't need split-by-major-mode any
- ;; more, so we can ditch it with nconc.
- (apply 'nconc (mapcar 'cddr split-by-major-mode))))
- subdivided-menus)))
+ (let ((others-list
+ (mouse-buffer-menu-alist
+ ;; we don't need split-by-major-mode any more,
+ ;; so we can ditch it with nconc.
+ (apply 'nconc (mapcar 'cddr split-by-major-mode)))))
+ (and others-list
+ (setq subdivided-menus
+ (cons (cons "Others" others-list)
+ subdivided-menus)))))
(setq menu (cons "Buffer Menu" (nreverse subdivided-menus))))
(progn
(setq alist (mouse-buffer-menu-alist buffers))
(let ((buf (x-popup-menu event menu))
(window (posn-window (event-start event))))
(when buf
- (or (framep window) (select-window window))
+ (select-window
+ (if (framep window) (frame-selected-window window)
+ window))
(switch-to-buffer buf)))))
(defun mouse-buffer-menu-alist (buffers)
(string< (buffer-name elt1) (buffer-name elt2))))))
(setq tail buffers)
(while tail
- (or (eq ?\ (aref (buffer-name (car tail)) 0))
+ (or (eq ?\s (aref (buffer-name (car tail)) 0))
(setq maxlen
(max maxlen
(length (buffer-name (car tail))))))
(save-excursion
(set-buffer elt)
(if buffer-read-only "%" " "))
- (or (buffer-file-name elt)
+ (or (buffer-file-name elt)
(save-excursion
(set-buffer elt)
(if list-buffers-directory
;;; These need to be rewritten for the new scroll bar implementation.
;;;!! ;; Commands for the scroll bar.
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-down (click)
;;;!! (interactive "@e")
;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-up (click)
;;;!! (interactive "@e")
;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-down-full ()
;;;!! (interactive "@")
;;;!! (scroll-down nil))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-up-full ()
;;;!! (interactive "@")
;;;!! (scroll-up nil))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-move-cursor (click)
;;;!! (interactive "@e")
;;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-absolute (event)
;;;!! (interactive "@e")
;;;!! (let* ((pos (car event))
;;;!! scale-factor)))
;;;!! (goto-char newpos)
;;;!! (recenter '(4)))))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-left (click)
;;;!! (interactive "@e")
;;;!! (scroll-left (1+ (car (mouse-coords click)))))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-right (click)
;;;!! (interactive "@e")
;;;!! (scroll-right (1+ (car (mouse-coords click)))))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-left-full ()
;;;!! (interactive "@")
;;;!! (scroll-left nil))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-right-full ()
;;;!! (interactive "@")
;;;!! (scroll-right nil))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
;;;!! (interactive "@e")
;;;!! (move-to-column (1+ (car (mouse-coords click)))))
-;;;!!
+;;;!!
;;;!! (defun mouse-scroll-absolute-horizontally (event)
;;;!! (interactive "@e")
;;;!! (let* ((pos (car event))
;;;!! (position (car pos))
;;;!! (length (car (cdr pos))))
;;;!! (set-window-hscroll (selected-window) 33)))
-;;;!!
+;;;!!
;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
-;;;!!
+;;;!!
;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
-;;;!!
+;;;!!
;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
-;;;!!
+;;;!!
;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
-;;;!!
+;;;!!
;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
;;;!! 'mouse-scroll-absolute-horizontally)
;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
-;;;!!
+;;;!!
;;;!! (global-set-key [horizontal-slider mouse-1]
;;;!! 'mouse-scroll-move-cursor-horizontally)
;;;!! (global-set-key [horizontal-slider mouse-2]
;;;!! 'mouse-scroll-move-cursor-horizontally)
;;;!! (global-set-key [horizontal-slider mouse-3]
;;;!! 'mouse-scroll-move-cursor-horizontally)
-;;;!!
+;;;!!
;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
-;;;!!
+;;;!!
;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
-;;;!!
+;;;!!
;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
;;;!! 'mouse-split-window-horizontally)
;;;!! (global-set-key [mode-line S-mouse-2]
;;;!! ;; (car relative-coordinate)
;;;!! ;; (car (cdr relative-coordinate)))
;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
-;;;!!
+;;;!!
;;;!! ;;
;;;!! ;; Dynamically put a box around the line indicated by point
;;;!! ;;
;;;!! ;; (abs-x (car pos))
;;;!! ;; (abs-y (cdr pos))
;;;!! ;; (relative-coordinate
-;;;!! ;; (coordinates-in-window-p (` ((, abs-x) (, abs-y)))
+;;;!! ;; (coordinates-in-window-p `(,abs-x ,abs-y)
;;;!! ;; (selected-window)))
;;;!! ;; (begin-reg nil)
;;;!! ;; (end-reg nil)
;;;!! ;; (progn
;;;!! ;; (x-erase-rectangle (selected-screen))
;;;!! ;; (setq last-line-drawn nil))))
-;;;!!
+;;;!!
;;;!! ;;; (defun test-x-rectangle ()
;;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
;;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
;;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
-;;;!!
+;;;!!
;;;!! ;;
;;;!! ;; Here is how to do double clicking in lisp. About to change.
;;;!! ;;
-;;;!!
+;;;!!
;;;!! (defvar double-start nil)
;;;!! (defconst double-click-interval 300
;;;!! "Max ticks between clicks")
-;;;!!
+;;;!!
;;;!! (defun double-down (event)
;;;!! (interactive "@e")
;;;!! (if double-start
;;;!! (sleep-for 1)))
;;;!! (setq double-start nil))
;;;!! (setq double-start (nth 4 event))))
-;;;!!
+;;;!!
;;;!! (defun double-up (event)
;;;!! (interactive "@e")
;;;!! (and double-start
;;;!! (> (- (nth 4 event ) double-start) double-click-interval)
;;;!! (setq double-start nil)))
-;;;!!
+;;;!!
;;;!! ;;; (defun x-test-doubleclick ()
;;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
;;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
-;;;!!
+;;;!!
;;;!! ;;
;;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar.
;;;!! ;;
-;;;!!
+;;;!!
;;;!! (defvar scrolled-lines 0)
;;;!! (defconst scroll-speed 1)
-;;;!!
+;;;!!
;;;!! (defun incr-scroll-down (event)
;;;!! (interactive "@e")
;;;!! (setq scrolled-lines 0)
;;;!! (incremental-scroll scroll-speed))
-;;;!!
+;;;!!
;;;!! (defun incr-scroll-up (event)
;;;!! (interactive "@e")
;;;!! (setq scrolled-lines 0)
;;;!! (incremental-scroll (- scroll-speed)))
-;;;!!
+;;;!!
;;;!! (defun incremental-scroll (n)
;;;!! (while (= (x-mouse-events) 0)
;;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
;;;!! (scroll-down n)
;;;!! (sit-for 300 t)))
-;;;!!
+;;;!!
;;;!! (defun incr-scroll-stop (event)
;;;!! (interactive "@e")
;;;!! (message "Scrolled %d lines" scrolled-lines)
;;;!! (setq scrolled-lines 0)
;;;!! (sleep-for 1))
-;;;!!
+;;;!!
;;;!! ;;; (defun x-testing-scroll ()
;;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
;;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
;;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
;;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
;;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
-;;;!!
+;;;!!
;;;!! ;;
;;;!! ;; Some playthings suitable for picture mode? They need work.
;;;!! ;;
-;;;!!
+;;;!!
;;;!! (defun mouse-kill-rectangle (event)
;;;!! "Kill the rectangle between point and the mouse cursor."
;;;!! (interactive "@e")
;;;!! (if (> point-save (point))
;;;!! (kill-rectangle (point) point-save)
;;;!! (kill-rectangle point-save (point))))))
-;;;!!
+;;;!!
;;;!! (defun mouse-open-rectangle (event)
;;;!! "Kill the rectangle between point and the mouse cursor."
;;;!! (interactive "@e")
;;;!! (if (> point-save (point))
;;;!! (open-rectangle (point) point-save)
;;;!! (open-rectangle point-save (point))))))
-;;;!!
+;;;!!
;;;!! ;; Must be a better way to do this.
-;;;!!
+;;;!!
;;;!! (defun mouse-multiple-insert (n char)
;;;!! (while (> n 0)
;;;!! (insert char)
;;;!! (setq n (1- n))))
-;;;!!
+;;;!!
;;;!! ;; What this could do is not finalize until button was released.
-;;;!!
+;;;!!
;;;!! (defun mouse-move-text (event)
;;;!! "Move text from point to cursor position, inserting spaces."
;;;!! (interactive "@e")
(defun mouse-set-font (&rest fonts)
"Select an emacs font from a list of known good fonts and fontsets."
(interactive
- (x-popup-menu
- last-nonmenu-event
- ;; Append list of fontsets currently defined.
- (append x-fixed-font-alist (list (generate-fontset-menu)))))
+ (progn (unless (display-multi-font-p)
+ (error "Cannot change fonts on this display"))
+ (x-popup-menu
+ (if (listp last-nonmenu-event)
+ last-nonmenu-event
+ (list '(0 0) (selected-window)))
+ ;; Append list of fontsets currently defined.
+ (append x-fixed-font-alist (list (generate-fontset-menu))))))
(if fonts
(let (font)
(while fonts
(global-set-key [double-mouse-1] 'mouse-set-point)
(global-set-key [triple-mouse-1] 'mouse-set-point)
+;; Clicking on the fringes causes hscrolling:
+(global-set-key [left-fringe mouse-1] 'mouse-set-point)
+(global-set-key [right-fringe mouse-1] 'mouse-set-point)
+
(global-set-key [mouse-2] 'mouse-yank-at-click)
(global-set-key [mouse-3] 'mouse-save-then-kill)
(if (not (eq system-type 'ms-dos))
(global-set-key [S-down-mouse-1] 'mouse-set-font))
;; C-down-mouse-2 is bound in facemenu.el.
-(global-set-key [C-down-mouse-3] 'mouse-major-mode-menu)
+(global-set-key [C-down-mouse-3] 'mouse-popup-menubar-stuff)
;; Replaced with dragging mouse-1
;; (global-set-key [S-mouse-1] 'mouse-set-mark)
+;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
+;; vertical-line prevents Emacs from signaling an error when the mouse
+;; button is released after dragging these lines, on non-toolkit
+;; versions.
(global-set-key [mode-line mouse-1] 'mouse-select-window)
(global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
+(global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
+(global-set-key [header-line mouse-1] 'mouse-select-window)
(global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
(global-set-key [mode-line mouse-3] 'mouse-delete-window)
(global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
;; This file contains the functionality of the old mldrag.el.
(defalias 'mldrag-drag-mode-line 'mouse-drag-mode-line)
(defalias 'mldrag-drag-vertical-line 'mouse-drag-vertical-line)
-(make-obsolete 'mldrag-drag-mode-line 'mouse-drag-mode-line)
-(make-obsolete 'mldrag-drag-vertical-line 'mouse-drag-vertical-line)
+(make-obsolete 'mldrag-drag-mode-line 'mouse-drag-mode-line "21.1")
+(make-obsolete 'mldrag-drag-vertical-line 'mouse-drag-vertical-line "21.1")
(provide 'mldrag)
+;;; arch-tag: 9a710ce1-914a-4923-9b81-697f7bf82ab3
;;; mouse.el ends here