;;; mouse.el --- window system-independent mouse support
-;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2011 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: hardware, mouse
:group 'mouse)
(defcustom mouse-drag-copy-region nil
- "If non-nil, mouse drag copies region to kill-ring."
+ "If non-nil, copy to kill-ring upon mouse adjustments of the region.
+
+This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
+addition to mouse drags."
:type 'boolean
:version "24.1"
:group 'mouse)
(minor-mode-menu-from-indicator indicator)))
(defun mouse-menu-major-mode-map ()
+ (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
(let* (;; Keymap from which to inherit; may be null.
(ancestor (mouse-menu-non-singleton
(and (current-local-map)
newmap))
(defun mouse-menu-non-singleton (menubar)
- "Given menu keymap,
-if it defines exactly one submenu, return just that submenu.
-Otherwise return the whole menu."
+ "Return menu keybar MENUBAR, or a lone submenu inside it.
+If MENUBAR defines exactly one submenu, return just that submenu.
+Otherwise, return MENUBAR."
(if menubar
(let (submap)
(map-keymap
"Return a keymap equivalent to the menu bar.
The contents are the items that would be in the menu bar whether or
not it is actually displayed."
+ (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]))
not it is actually displayed."
(interactive "@e \nP")
(run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
- (popup-menu (mouse-menu-bar-map) event prefix))
+ (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
(make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map "23.1")
(defun mouse-popup-menubar-stuff (event prefix)
;; a `drag-mouse-1'. In any case `on-link' would have been nulled
;; above if there had been any significant mouse movement.
(when (and on-link (eq 'mouse-1 (car-safe event)))
+ ;; If mouse-2 has never been done by the user, it doesn't
+ ;; have the necessary property to be interpreted correctly.
+ (put 'mouse-2 'event-kind 'mouse-click)
(push (cons 'mouse-2 (cdr event)) unread-command-events))))))
(defun mouse-drag-mode-line (start-event)
(defun mouse-set-region (click)
"Set the region to the text dragged over, and copy to kill ring.
-This should be bound to a mouse drag event."
+This should be bound to a mouse drag event.
+See the `mouse-drag-copy-region' variable to control whether this
+command alters the kill ring or not."
(interactive "e")
(mouse-minibuffer-check click)
(select-window (posn-window (event-start click)))
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 (get-buffer-create "*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-track start-event t))))
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (mouse-drag-track start-event t))
(defun mouse-posn-property (pos property)
(or mouse-yank-at-point (mouse-set-point click))
(let ((primary
(cond
- ((fboundp 'x-get-selection-value) ; MS-DOS and MS-Windows
+ ((eq system-type 'windows-nt)
+ ;; MS-Windows emulates PRIMARY in x-get-selection, but not
+ ;; in x-get-selection-value (the latter only accesses the
+ ;; clipboard). So try PRIMARY first, in case they selected
+ ;; something with the mouse in the current Emacs session.
+ (or (x-get-selection 'PRIMARY)
+ (x-get-selection-value)))
+ ((fboundp 'x-get-selection-value) ; MS-DOS and X.
+ ;; On X, x-get-selection-value supports more formats and
+ ;; encodings, so use it in preference to x-get-selection.
(or (x-get-selection-value)
(x-get-selection 'PRIMARY)))
;; FIXME: What about xterm-mouse-mode etc.?
have selected whole words or lines, move point or mark to the
word or line boundary closest to CLICK instead.
+If `mouse-drag-copy-region' is non-nil, this command also saves the
+new region to the kill ring (replacing the previous kill if the
+previous region was just saved to the kill ring).
+
If this command is called a second consecutive time with the same
-CLICK position, kill the region."
+CLICK position, kill the region (or delete it
+if `mouse-drag-copy-region' is non-nil)"
(interactive "e")
(mouse-minibuffer-check click)
(let* ((posn (event-start click))
((and (eq last-command 'mouse-save-then-kill)
(eq click-pt mouse-save-then-kill-posn)
(eq window (selected-window)))
- (kill-region (mark t) (point))
+ (if mouse-drag-copy-region
+ ;; Region already saved in the previous click;
+ ;; don't make a duplicate entry, just delete.
+ (delete-region (mark t) (point))
+ (kill-region (mark t) (point)))
(setq mouse-selection-click-count 0)
(setq mouse-save-then-kill-posn nil))
(goto-char (nth 1 range)))
(setq deactivate-mark nil)
(mouse-set-region-1)
+ (when mouse-drag-copy-region
+ ;; Region already copied to kill-ring once, so replace.
+ (kill-new (filter-buffer-substring (mark t) (point)) t))
;; Arrange for a repeated mouse-3 to kill the region.
(setq mouse-save-then-kill-posn click-pt)))
(if before-scroll (goto-char before-scroll)))
(exchange-point-and-mark)
(mouse-set-region-1)
+ (when mouse-drag-copy-region
+ (kill-new (filter-buffer-substring (mark t) (point))))
(setq mouse-save-then-kill-posn click-pt)))))
\f
("Outline" . "Text")
("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML")
("log\\|diff\\|vc\\|cvs\\|Annotate" . "Version Control") ; "Change Management"?
+ ("Threads\\|Memory\\|Disassembly\\|Breakpoints\\|Frames\\|Locals\\|Registers\\|Inferior I/O\\|Debugger"
+ . "GDB")
("Lisp" . "Lisp")))
"How to group various major modes together in \\[mouse-buffer-menu].
Each element has the form (REGEXP . GROUPNAME).
(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)
+(defun mouse--strip-first-event (_prompt)
+ (substring (this-single-command-raw-keys) 1))
+
+(define-key function-key-map [left-fringe mouse-1] 'mouse--strip-first-event)
+(define-key function-key-map [right-fringe mouse-1] 'mouse--strip-first-event)
(global-set-key [mouse-2] 'mouse-yank-primary)
;; Allow yanking also when the corresponding cursor is "in the fringe".
-(global-set-key [right-fringe mouse-2] 'mouse-yank-at-click)
-(global-set-key [left-fringe mouse-2] 'mouse-yank-at-click)
+(define-key function-key-map [right-fringe mouse-2] 'mouse--strip-first-event)
+(define-key function-key-map [left-fringe mouse-2] 'mouse--strip-first-event)
(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)
+(define-key function-key-map [right-fringe mouse-3] 'mouse--strip-first-event)
+(define-key function-key-map [left-fringe mouse-3] 'mouse--strip-first-event)
;; By binding these to down-going events, we let the user use the up-going
;; event to make the selection, saving a click.
(provide 'mouse)
-;; 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 "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
HCoop / bpt / emacs.git / blobdiff