;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1995, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2014 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware, mouse
;; Package: emacs
;; This package provides various useful commands (including help
;; system access) through the mouse. All this code assumes that mouse
;; interpretation has been abstracted into Emacs input events.
-;;
-;; The code is rather X-dependent.
;;; Code:
(defun mouse--down-1-maybe-follows-link (&optional _prompt)
"Turn `mouse-1' events into `mouse-2' events if follows-link.
Expects to be bound to `down-mouse-1' in `key-translation-map'."
- (if (or (null mouse-1-click-follows-link)
- (not (eq (if (eq mouse-1-click-follows-link 'double)
- 'double-down-mouse-1 'down-mouse-1)
- (car-safe last-input-event)))
- (not (mouse-on-link-p (event-start last-input-event)))
- (and (not mouse-1-click-in-non-selected-windows)
- (not (eq (selected-window)
- (posn-window (event-start last-input-event))))))
- nil
+ (when (and mouse-1-click-follows-link
+ (eq (if (eq mouse-1-click-follows-link 'double)
+ 'double-down-mouse-1 'down-mouse-1)
+ (car-safe last-input-event))
+ (mouse-on-link-p (event-start last-input-event))
+ (or mouse-1-click-in-non-selected-windows
+ (eq (selected-window)
+ (posn-window (event-start last-input-event)))))
(let ((this-event last-input-event)
(timedout
(sit-for (if (numberp mouse-1-click-follows-link)
'double-mouse-1 'mouse-1))
;; Turn the mouse-1 into a mouse-2 to follow links.
(let ((newup (if (eq mouse-1-click-follows-link 'double)
- 'double-mouse-2 'mouse-2))
- (newdown (if (eq mouse-1-click-follows-link 'double)
- 'double-down-mouse-2 'down-mouse-2)))
+ 'double-mouse-2 'mouse-2)))
;; If mouse-2 has never been done by the user, it doesn't have
;; the necessary property to be interpreted correctly.
- (put newup 'event-kind (get (car event) 'event-kind))
- (put newdown 'event-kind (get (car this-event) 'event-kind))
+ (unless (get newup 'event-kind)
+ (put newup 'event-kind (get (car event) 'event-kind)))
(push (cons newup (cdr event)) unread-command-events)
- ;; Modify the event in place, so read-key-sequence doesn't
- ;; generate a second fake prefix key (see fake_prefixed_keys in
- ;; src/keyboard.c).
- (setcar this-event newdown)
- (vector this-event))
+ ;; Don't change the down event, only the up-event (bug#18212).
+ nil)
(push event unread-command-events)
nil))))))
(window (posn-window start))
(frame (window-frame window))
(minibuffer-window (minibuffer-window frame))
- (on-link (and mouse-1-click-follows-link
- (mouse-on-link-p start)))
(side (and (eq line 'vertical)
(or (cdr (assq 'vertical-scroll-bars
(frame-parameters frame)))
;; Check whether header-line can be dragged at all.
(if (window-at-side-p window 'top)
(setq draggable nil)
- (setq height (/ (window-header-line-height window) 2))
+ ;; window-pixel-edges includes the header and mode lines, so
+ ;; we need to account for that when calculating window growth.
+ ;; On GUI frames, assume the mouse is approximately in the
+ ;; middle of the header/mode line, so we need only half the
+ ;; height in pixels.
+ (setq height
+ (cond
+ ((display-graphic-p frame)
+ (/ (window-header-line-height window) 2))
+ (t (window-header-line-height window))))
(setq window (window-in-direction 'above window t))))
((eq line 'mode)
;; Check whether mode-line can be dragged at all.
(eq minibuffer-window
(active-minibuffer-window))))))
(setq draggable nil)
- (setq height (/ (window-mode-line-height window) 2))))
+ (setq height
+ (cond
+ ((display-graphic-p frame)
+ (/ (window-mode-line-height window) 2))
+ (t (window-mode-line-height window))))))
((eq line 'vertical)
;; Get the window to adjust for the vertical case. If the scroll
;; bar is on the window's right or we drag a vertical divider,
(unless (zerop growth)
(setq dragged t)
(adjust-window-trailing-edge
- window (if (eq line 'mode) growth (- growth)) nil t))))))
- ;; Process the terminating event.
- (when (and (mouse-event-p event) on-link (not dragged)
- (mouse--remap-link-click-p start-event 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)
- (setcar event 'mouse-2)
- (push event unread-command-events))))
+ window (if (eq line 'mode) growth (- growth)) nil t))))))))
(defun mouse-drag-mode-line (start-event)
"Change the height of a window by dragging on the mode line."
(str (posn-string pos)))
(or (and str
(get-text-property (cdr str) property (car str)))
- (and pt
+ ;; FIXME: mouse clicks on the mode-line come with a position in
+ ;; (nth 5). Maybe we should change the C code instead so that
+ ;; mouse-clicks don't include a position there!
+ (and pt (not (memq (posn-area pos) '(mode-line header-line)))
(get-char-property pt property w))))
(get-char-property pos property)))
(unless primary
(error "No selection is available"))
(push-mark (point))
- (insert primary)))
+ (insert-for-yank primary)))
(defun mouse-kill-ring-save (click)
"Copy the region between point and the mouse click in the kill ring.
(or mouse-yank-at-point (mouse-set-point click))
(let ((secondary (x-get-selection 'SECONDARY)))
(if secondary
- (insert secondary)
+ (insert-for-yank secondary)
(error "No secondary selection"))))
(defun mouse-kill-secondary ()