;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1995, 1999-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2016 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware, mouse
(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 ((timedout
- (sit-for (if (numberp mouse-1-click-follows-link)
- (/ (abs mouse-1-click-follows-link) 1000.0)
- 0))))
- (if (if (and (numberp mouse-1-click-follows-link)
- (>= mouse-1-click-follows-link 0))
- timedout (not timedout))
- nil
-
- (let ((event (read-key))) ;Use read-key so it works for xterm-mouse-mode!
- (if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double)
- '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)))
- ;; If mouse-2 has never been done by the user, it doesn't have
- ;; the necessary property to be interpreted correctly.
- (unless (get newup 'event-kind)
- (put newup 'event-kind (get (car event) 'event-kind)))
- (push (cons newup (cdr event)) unread-command-events)
- ;; Don't change the down event, only the up-event (bug#18212).
- nil)
- (push event unread-command-events)
- nil))))))
+ (car-safe last-input-event)))
+ (let ((action (mouse-on-link-p (event-start last-input-event))))
+ (when (and action
+ (or mouse-1-click-in-non-selected-windows
+ (eq (selected-window)
+ (posn-window (event-start last-input-event)))))
+ (let ((timedout
+ (sit-for (if (numberp mouse-1-click-follows-link)
+ (/ (abs mouse-1-click-follows-link) 1000.0)
+ 0))))
+ (if (if (and (numberp mouse-1-click-follows-link)
+ (>= mouse-1-click-follows-link 0))
+ timedout (not timedout))
+ nil
+ ;; Use read-key so it works for xterm-mouse-mode!
+ (let ((event (read-key)))
+ (if (eq (car-safe event)
+ (if (eq mouse-1-click-follows-link 'double)
+ 'double-mouse-1 'mouse-1))
+ (progn
+ ;; Turn the mouse-1 into a mouse-2 to follow links,
+ ;; but only if ‘mouse-on-link-p’ hasn’t returned a
+ ;; string or vector (see its docstring).
+ (if (or (stringp action) (vectorp action))
+ (push (aref action 0) unread-command-events)
+ (let ((newup (if (eq mouse-1-click-follows-link 'double)
+ '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.
+ (unless (get newup 'event-kind)
+ (put newup 'event-kind (get (car event) 'event-kind)))
+ (push (cons newup (cdr event)) unread-command-events)))
+ ;; Don't change the down event, only the up-event
+ ;; (bug#18212).
+ nil)
+ (push event unread-command-events)
+ nil))))))))
(define-key key-translation-map [down-mouse-1]
#'mouse--down-1-maybe-follows-link)
(if (fboundp mm-fun) ; bug#20201
`(keymap
,indicator
- (turn-off menu-item "Turn Off minor mode" ,mm-fun)
+ (turn-off menu-item "Turn off minor mode" ,mm-fun)
(help menu-item "Help for minor mode"
(lambda () (interactive)
(describe-function ',mm-fun)))))))
(first-line window-min-height)
(last-line (- (window-height) window-min-height)))
(if (< last-line first-line)
- (error "Window too short to split")
- (split-window-vertically
- (min (max new-height first-line) last-line))))))
+ (user-error "Window too short to split")
+ ;; Bind `window-combination-resize' to nil so we are sure to get
+ ;; the split right at the line clicked on.
+ (let (window-combination-resize)
+ (split-window-vertically
+ (min (max new-height first-line) last-line)))))))
(defun mouse-split-window-horizontally (click)
"Select Emacs window mouse is on, then split it horizontally in half.
(first-col window-min-width)
(last-col (- (window-width) window-min-width)))
(if (< last-col first-col)
- (error "Window too narrow to split")
- (split-window-horizontally
- (min (max new-width first-col) last-col))))))
+ (user-error "Window too narrow to split")
+ ;; Bind `window-combination-resize' to nil so we are sure to get
+ ;; the split right at the column clicked on.
+ (let (window-combination-resize)
+ (split-window-horizontally
+ (min (max new-width first-col) last-col)))))))
(defun mouse-drag-line (start-event line)
"Drag a mode line, header line, or vertical line with the mouse.
(or (not resize-mini-windows)
(eq minibuffer-window
(active-minibuffer-window)))))))
- (setq draggable nil))))
+ (setq draggable nil)))
+ ((eq line 'vertical)
+ (let ((divider-width (frame-right-divider-width frame)))
+ (when (and (or (not (numberp divider-width))
+ (zerop divider-width))
+ (eq (frame-parameter frame 'vertical-scroll-bars) 'left))
+ (setq window (window-in-direction 'left window t))))))
(let* ((exitfun nil)
(move
(setq dragged t)
(adjust-window-trailing-edge window growth nil t))
(setq last-position position))))))
- ;; Start tracking.
- (setq track-mouse t)
+ ;; Start tracking. The special value 'dragging' signals the
+ ;; display engine to freeze the mouse pointer shape for as long
+ ;; as we drag.
+ (setq track-mouse 'dragging)
;; Loop reading events and sampling the position of the mouse.
(setq exitfun
(set-transient-map
(mouse-minibuffer-check click)
(select-window (posn-window (event-start click)))
(let ((beg (posn-point (event-start click)))
- (end (posn-point (event-end click)))
+ (end
+ (if (eq (posn-window (event-end click)) (selected-window))
+ (posn-point (event-end click))
+ ;; If the mouse ends up in any other window or on the menu
+ ;; bar, use `window-point' of selected window (Bug#23707).
+ (window-point)))
(click-count (event-click-count click)))
(let ((drag-start (terminal-parameter nil 'mouse-drag-start)))
(when drag-start
(= start end)
(char-after start)
(= (char-syntax (char-after start)) ?\())
- (list start
- (save-excursion
- (goto-char start)
- (forward-sexp 1)
- (point))))
+ (if (/= (syntax-class (syntax-after start)) 4) ; raw syntax code for ?\(
+ ;; This happens in CC Mode when unbalanced parens in CPP
+ ;; constructs are given punctuation syntax with
+ ;; syntax-table text properties. (2016-02-21).
+ (signal 'scan-error (list "Containing expression ends prematurely"
+ start start))
+ (list start
+ (save-excursion
+ (goto-char start)
+ (forward-sexp 1)
+ (point)))))
((and (= mode 1)
(= start end)
(char-after start)
(= (char-syntax (char-after start)) ?\)))
- (list (save-excursion
- (goto-char (1+ start))
- (backward-sexp 1)
- (point))
- (1+ start)))
+ (if (/= (syntax-class (syntax-after start)) 5) ; raw syntax code for ?\)
+ ;; See above comment about CC Mode.
+ (signal 'scan-error (list "Unbalanced parentheses" start start))
+ (list (save-excursion
+ (goto-char (1+ start))
+ (backward-sexp 1)
+ (point))
+ (1+ start))))
((and (= mode 1)
(= start end)
(char-after start)
(interactive "e")
(mouse-minibuffer-check click)
(select-window (posn-window (event-start click)))
- ;; We don't use save-excursion because that preserves the mark too.
+ ;; FIXME: Use save-excursion
(let ((point-save (point)))
(unwind-protect
(progn (mouse-set-point 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-functions after-change-functions)
+ (let ((inhibit-modification-hooks t))
(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-functions after-change-functions)
+ (let ((inhibit-modification-hooks t))
(primitive-undo 1 buffer-undo-list))
;; Now delete the rest of the specified region,
;; but don't record it.
;; Font selection.
(defun font-menu-add-default ()
- (let* ((default (cdr (assq 'font (frame-parameters (selected-frame)))))
+ (let* ((default (frame-parameter nil 'font))
(font-alist x-fixed-font-alist)
(elt (or (assoc "Misc" font-alist) (nth 1 font-alist))))
(if (assoc "Default" elt)
;; 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 drag-mouse-1] 'mouse-select-window)
+(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
+(global-set-key [mode-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)
(global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
-(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
+(global-set-key [horizontal-scroll-bar C-mouse-2] 'mouse-split-window-horizontally)
(global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
+(global-set-key [vertical-line mouse-1] 'mouse-select-window)
+(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
(global-set-key [right-divider down-mouse-1] 'mouse-drag-vertical-line)
+(global-set-key [right-divider mouse-1] 'ignore)
+(global-set-key [right-divider C-mouse-2] 'mouse-split-window-vertically)
(global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
-(global-set-key [vertical-line mouse-1] 'mouse-select-window)
+(global-set-key [bottom-divider mouse-1] 'ignore)
+(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
(provide 'mouse)