;;; mouse.el --- window system-independent mouse support
;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware, mouse
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; mouse-major-mode-menu was using `command-execute' instead.
(call-interactively cmd))))
+(defun minor-mode-menu-from-indicator (indicator)
+ "Show menu, if any, for minor mode specified by INDICATOR.
+Interactively, INDICATOR is read using completion."
+ (interactive (list (completing-read "Minor mode indicator: "
+ (describe-minor-mode-completion-table-for-indicator))))
+ (let ((minor-mode (lookup-minor-mode-from-indicator indicator)))
+ (if minor-mode
+ (let* ((map (cdr-safe (assq minor-mode minor-mode-map-alist)))
+ (menu (and (keymapp map) (lookup-key map [menu-bar]))))
+ (if menu
+ (popup-menu menu)
+ (message "No menu for minor mode `%s'" minor-mode)))
+ (error "Cannot find minor mode for `%s'" indicator))))
+
+(defun mouse-minor-mode-menu (event)
+ "Show minor-mode menu for EVENT on minor modes area of the mode line."
+ (interactive "@e")
+ (let ((indicator (car (nth 4 (car (cdr event))))))
+ (minor-mode-menu-from-indicator indicator)))
+
(defvar mouse-major-mode-menu-prefix) ; dynamically bound
(defun mouse-major-mode-menu (event &optional prefix)
;; 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)))
+ (make-sparse-keymap (concat (format-mode-line mode-name)
+ " Mode"))
+ menu-bar-edit-menu))
+ uniq)
(if ancestor
;; Make our menu inherit from the desired keymap which we want
;; to display as the menu now.
- (set-keymap-parent newmap ancestor))
+ ;; Sometimes keymaps contain duplicate menu code, leading to
+ ;; duplicates in the popped-up menu. Avoid this by simply
+ ;; taking the first of any identically-named menus.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg00469.html
+ (set-keymap-parent newmap
+ (progn
+ (dolist (e ancestor)
+ (unless (and (listp e)
+ (assoc (car e) uniq))
+ (setq uniq (append uniq (list e)))))
+ uniq)))
(popup-menu newmap event prefix)))
(cons 'keymap
(cons (concat
(capitalize (subst-char-in-string
- ?- ?\ (symbol-name
+ ?- ?\s (symbol-name
minor-mode)))
" Menu")
(cdr menu)))))
(or (null local-menu)
(stringp local-title-or-map)
(setq local-menu (cons 'keymap
- (cons (concat mode-name " Mode Menu")
+ (cons (concat (format-mode-line mode-name)
+ " Mode Menu")
(cdr local-menu)))))
(or (stringp global-title-or-map)
(setq global-menu (cons 'keymap
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
mode-line-p
(not (one-window-p t))
(= (nth 1 (window-edges minibuffer))
- (nth 3 (window-edges)))))
+ (nth 3 (window-edges start-event-window)))))
;; loop reading events and sampling the position of
;; the mouse.
;; - there is a scroll-bar-movement event
;; (same as mouse movement for our purposes)
;; quit if
- ;; - there is a keyboard event or some other unknown event
- ;; unknown event.
- (cond ((integerp event)
+ ;; - there is a keyboard event or some other unknown event.
+ (cond ((not (consp event))
(setq done t))
((memq (car event) '(switch-frame select-window))
((not (memq (car event) '(mouse-movement scroll-bar-movement)))
(when (consp event)
- (push event unread-command-events))
+ ;; Do not unread a drag-mouse-1 event since it will cause the
+ ;; selection of the window above when dragging the modeline
+ ;; above the selected window.
+ (unless (eq (car event) 'drag-mouse-1)
+ (push event unread-command-events)))
(setq done t))
((not (eq (car mouse) start-event-frame))
(t
(setq y (cdr (cdr mouse))
- edges (window-edges)
+ edges (window-edges start-event-window)
top (nth 1 edges)
bot (nth 3 edges))
(and (not should-enlarge-minibuffer)
(> growth 0)
mode-line-p
- (/= top (nth 1 (window-edges)))))
+ (/= top
+ (nth 1 (window-edges
+ ;; Choose right window.
+ start-event-window)))))
(set-window-configuration wconfig)))))))))
(defun mouse-drag-mode-line (start-event)
(echo-keystrokes 0)
(start-event-frame (window-frame (car (car (cdr start-event)))))
(start-event-window (car (car (cdr start-event))))
- event mouse x left right edges wconfig growth
+ event mouse x left right edges growth
(which-side
(or (cdr (assq 'vertical-scroll-bars (frame-parameters start-event-frame)))
'right)))
(error "Attempt to drag leftmost scrollbar")))
(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)
;; loop reading events and sampling the position of
;; the mouse.
(while (not done)
;; If the scroll bar is on the window's left,
;; adjust the window on the left.
(if (eq which-side 'right)
- (selected-window)
+ start-event-window
(mouse-drag-vertical-line-rightward-window
- (selected-window)))))
+ start-event-window))))
(setq x (- (car (cdr mouse))
(if (eq which-side 'right) 0 2))
edges (window-edges window)
(mouse-drag-track start-event t))))
+(defun mouse-posn-property (pos property)
+ "Look for a property at click position.
+POS may be either a buffer position or a click position like
+those returned from `event-start'. If the click position is on
+a string, the text property PROPERTY is examined.
+If this is nil or the click is not on a string, then
+the corresponding buffer position is searched for PROPERTY.
+If PROPERTY is encountered in one of those places,
+its value is returned."
+ (if (consp pos)
+ (let ((w (posn-window pos)) (pt (posn-point pos))
+ (str (posn-string pos)))
+ (or (and str
+ (get-text-property (cdr str) property (car str)))
+ (and pt
+ (get-char-property pt property w))))
+ (get-char-property pos property)))
+
(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 a mouse
- 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)))))))
+ (let ((action
+ (and (or (not (consp pos))
+ mouse-1-click-in-non-selected-windows
+ (eq (selected-window) (posn-window pos)))
+ (or (mouse-posn-property pos 'follow-link)
+ (key-binding [follow-link] nil t pos)))))
+ (cond
+ ((eq action 'mouse-face)
+ (and (mouse-posn-property pos 'mouse-face) t))
+ ((functionp action)
+ ;; FIXME: This seems questionable if the click is not in a buffer.
+ ;; Should we instead decide that `action' takes a `posn'?
+ (if (consp pos)
+ (with-current-buffer (window-buffer (posn-window pos))
+ (funcall action (posn-point pos)))
+ (funcall action pos)))
+ (t action))))
(defun mouse-fixup-help-message (msg)
"Fix help message MSG for `mouse-1-click-follows-link'."
(let ((range (mouse-start-end start end mode)))
(move-overlay ol (car range) (nth 1 range))))
-(defun mouse-drag-track (start-event &optional
+(defun mouse-drag-track (start-event &optional
do-mouse-drag-region-post-process)
"Track mouse drags by highlighting area between point and cursor.
The region will be defined with mark and point, and the overlay
;; Use start-point before the intangibility
;; treatment, in case we click on a link inside an
;; intangible text.
- (mouse-on-link-p start-point)))
+ (mouse-on-link-p start-posn)))
(click-count (1- (event-click-count start-event)))
(remap-double-click (and on-link
(eq mouse-1-click-follows-link 'double)
- (= click-count 1))))
+ (= click-count 1)))
+ ;; Suppress automatic hscrolling, because that is a nuisance
+ ;; when setting point near the right fringe (but see below).
+ (automatic-hscrolling-saved automatic-hscrolling)
+ (automatic-hscrolling nil))
(setq mouse-selection-click-count click-count)
;; In case the down click is in the middle of some intangible text,
;; use the end of that text, and put it in START-POINT.
(memq (car-safe event) '(switch-frame select-window))))
(if (memq (car-safe event) '(switch-frame select-window))
nil
+ ;; Automatic hscrolling did not occur during the call to
+ ;; `read-event'; but if the user subsequently drags the
+ ;; mouse, go ahead and hscroll.
+ (let ((automatic-hscrolling automatic-hscrolling-saved))
+ (redisplay))
(setq end (event-end event)
end-point (posn-point end))
(if (numberp end-point)
(let* ((fun (key-binding (vector (car event))))
(do-multi-click (and (> (event-click-count event) 0)
(functionp fun)
- (not (memq fun
- '(mouse-set-point
+ (not (memq fun
+ '(mouse-set-point
mouse-set-region))))))
;; Run the binding of the terminating up-event, if possible.
(if (and (not (= (overlay-start mouse-drag-overlay)
(overlay-start mouse-drag-overlay))
region-termination))
last-command this-command)
+ (when (eq transient-mark-mode 'identity)
+ ;; Reset `transient-mark-mode' to avoid expanding the region
+ ;; while scrolling (compare thread on "Erroneous selection
+ ;; extension ..." on bug-gnu-emacs from 2007-06-10).
+ (setq transient-mark-mode nil))
(push-mark region-commencement t t)
(goto-char region-termination)
(if (not do-mouse-drag-region-post-process)
(if do-multi-click (goto-char start-point))
(delete-overlay mouse-drag-overlay)
(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)))
- (when (and on-link
+ (= 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)))
+ (when (and on-link
(or (not end-point) (= end-point start-point))
(consp event)
(or remap-double-click
(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))))
(unless ignore
;; For certain special keys, delete the region.
(if (member key mouse-region-delete-keys)
- (delete-region (mark t) (point))
+ (progn
+ ;; Since notionally this is a separate command,
+ ;; run all the hooks that would be run if it were
+ ;; executed separately.
+ (run-hooks 'post-command-hook)
+ (setq last-command this-command)
+ (setq this-original-command 'delete-region)
+ (setq this-command (or (command-remapping this-original-command)
+ this-original-command))
+ (run-hooks 'pre-command-hook)
+ (call-interactively this-command))
;; Otherwise, unread the key so it gets executed normally.
(setq unread-command-events
(nconc events unread-command-events))))
(setq mouse-selection-click-count 0)
(yank arg))
+(defun mouse-yank-primary (click)
+ "Insert the primary selection at the position clicked on.
+Move point to the end of the inserted text.
+If `mouse-yank-at-point' is non-nil, insert at point
+regardless of where you click."
+ (interactive "e")
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (or mouse-yank-at-point (mouse-set-point click))
+ (let ((primary (x-get-selection 'PRIMARY)))
+ (if primary
+ (insert (x-get-selection 'PRIMARY))
+ (error "No primary selection"))))
+
(defun mouse-kill-ring-save (click)
"Copy the region between point and the mouse click in the kill ring.
This does not delete the region; it acts like \\[kill-ring-save]."
(with-current-buffer (window-buffer (posn-window posn))
(if (numberp (posn-point posn))
(setq beg (posn-point posn)))
- (move-overlay mouse-secondary-overlay beg (posn-point end)))))
+ (move-overlay mouse-secondary-overlay beg (posn-point end))
+ (x-set-selection
+ 'SECONDARY
+ (buffer-substring (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))))))
(defun mouse-drag-secondary (start-event)
"Set the secondary selection to the text that the mouse is dragged over.
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))
- (insert (x-get-selection 'SECONDARY)))
+ (let ((secondary (x-get-selection 'SECONDARY)))
+ (if secondary
+ (insert (x-get-selection 'SECONDARY))
+ (error "No secondary selection"))))
(defun mouse-kill-secondary ()
"Kill the text in the secondary selection.
(mouse-minibuffer-check event)
(let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares)
;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
- (let ((tail buffers))
- (while tail
- ;; Divide all buffers into buckets for various major modes.
- ;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
- (with-current-buffer (car tail)
- (let* ((adjusted-major-mode major-mode) elt)
- (let ((tail mouse-buffer-menu-mode-groups))
- (while tail
- (if (string-match (car (car tail)) mode-name)
- (setq adjusted-major-mode (cdr (car tail))))
- (setq tail (cdr tail))))
- (setq elt (assoc adjusted-major-mode split-by-major-mode))
- (if (null elt)
- (setq elt (list adjusted-major-mode
- (if (stringp adjusted-major-mode)
- adjusted-major-mode
- mode-name))
- split-by-major-mode (cons elt split-by-major-mode)))
- (or (memq (car tail) (cdr (cdr elt)))
- (setcdr (cdr elt) (cons (car tail) (cdr (cdr elt)))))))
- (setq tail (cdr tail))))
+ (dolist (buf buffers)
+ ;; Divide all buffers into buckets for various major modes.
+ ;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
+ (with-current-buffer buf
+ (let* ((adjusted-major-mode major-mode) elt)
+ (dolist (group mouse-buffer-menu-mode-groups)
+ (when (string-match (car group) (format-mode-line mode-name))
+ (setq adjusted-major-mode (cdr group))))
+ (setq elt (assoc adjusted-major-mode split-by-major-mode))
+ (unless elt
+ (setq elt (list adjusted-major-mode
+ (if (stringp adjusted-major-mode)
+ adjusted-major-mode
+ (format-mode-line mode-name nil nil buf)))
+ split-by-major-mode (cons elt split-by-major-mode)))
+ (or (memq buf (cdr (cdr elt)))
+ (setcdr (cdr elt) (cons buf (cdr (cdr elt))))))))
;; Compute the sum of squares of sizes of the major-mode buckets.
(let ((tail split-by-major-mode))
(setq sum-of-squares 0)
(setq tail buffers)
(while tail
(let ((elt (car tail)))
- (if (/= (aref (buffer-name elt) 0) ?\ )
+ (if (/= (aref (buffer-name elt) 0) ?\s)
(setq head
(cons
(cons
(format
- (format "%%%ds %%s%%s %%s" maxlen)
+ (format "%%-%ds %%s%%s %%s" maxlen)
(buffer-name elt)
(if (buffer-modified-p elt) "*" " ")
(save-excursion
"X fonts suitable for use in Emacs.")
(defun mouse-set-font (&rest fonts)
- "Select an emacs font from a list of known good fonts and fontsets."
+ "Select an Emacs font from a list of known good fonts and fontsets."
(interactive
(progn (unless (display-multi-font-p)
(error "Cannot change fonts on this display"))
(global-set-key [mouse-2] 'mouse-yank-at-click)
;; Allow yanking also when the corresponding cursor is "in the fringe".
-(global-set-key [right-fringe mouse-2] [mouse-2])
+(global-set-key [right-fringe mouse-2] 'mouse-yank-at-click)
+(global-set-key [left-fringe mouse-2] 'mouse-yank-at-click)
(global-set-key [mouse-3] 'mouse-save-then-kill)
+(global-set-key [right-fringe mouse-3] 'mouse-save-then-kill)
+(global-set-key [left-fringe mouse-3] 'mouse-save-then-kill)
;; By binding these to down-going events, we let the user use the up-going
;; event to make the selection, saving a click.
HCoop / bpt / emacs.git / blobdiff