diff options
Diffstat (limited to 'lisp/mouse.el')
| -rw-r--r-- | lisp/mouse.el | 515 |
1 files changed, 238 insertions, 277 deletions
diff --git a/lisp/mouse.el b/lisp/mouse.el index e2674184f69..e78eca40bc5 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -102,8 +102,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." (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 + (let ((timedout (sit-for (if (numberp mouse-1-click-follows-link) (/ (abs mouse-1-click-follows-link) 1000.0) 0)))) @@ -112,7 +111,7 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'." timedout (not timedout)) nil - (let ((event (read-event))) + (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. @@ -307,13 +306,14 @@ This command must be bound to a mouse click." (or (eq frame oframe) (set-mouse-position (selected-frame) (1- (frame-width)) 0)))) -(defun mouse-tear-off-window (click) - "Delete the window clicked on, and create a new frame displaying its buffer." +(define-obsolete-function-alias 'mouse-tear-off-window 'tear-off-window "24.4") +(defun tear-off-window (click) + "Delete the selected window, and create a new frame displaying its buffer." (interactive "e") (mouse-minibuffer-check click) (let* ((window (posn-window (event-start click))) (buf (window-buffer window)) - (frame (make-frame))) + (frame (make-frame))) ;FIXME: Use pop-to-buffer. (select-frame frame) (switch-to-buffer buf) (delete-window window))) @@ -355,24 +355,6 @@ This command must be bound to a mouse click." (split-window-horizontally (min (max new-width first-col) last-col)))))) -;; `mouse-drag-line' is now the common routine for handling all line -;; dragging events combining the earlier `mouse-drag-mode-line-1' and -;; `mouse-drag-vertical-line'. It should improve the behavior of line -;; dragging wrt Emacs 23 as follows: - -;; (1) Gratuitous error messages and restrictions have been (hopefully) -;; removed. (The help-echo that dragging the mode-line can resize a -;; one-window-frame's window will still show through via bindings.el.) - -;; (2) No gratuitous selection of other windows should happen. (This -;; has not been completely fixed for mouse-autoselected windows yet.) - -;; (3) Mouse clicks below a scroll-bar should pass through via unread -;; command events. - -;; Note that `window-in-direction' replaces `mouse-drag-window-above' -;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1. - (defun mouse-drag-line (start-event line) "Drag a mode line, header line, or vertical line with the mouse. START-EVENT is the starting mouse-event of the drag action. LINE @@ -383,116 +365,136 @@ must be one of the symbols `header', `mode', or `vertical'." (start (event-start start-event)) (window (posn-window start)) (frame (window-frame window)) - (minibuffer-window (minibuffer-window frame)) - (side (and (eq line 'vertical) - (or (cdr (assq 'vertical-scroll-bars - (frame-parameters frame))) - 'right))) + ;; `position' records the x- or y-coordinate of the last + ;; sampled position. + (position (if (eq line 'vertical) + (+ (window-pixel-left window) + (car (posn-x-y start))) + (+ (window-pixel-top window) + (cdr (posn-x-y start))))) + ;; `last-position' records the x- or y-coordinate of the + ;; previously sampled position. The difference of `position' + ;; and `last-position' determines the size change of WINDOW. + (last-position position) (draggable t) - height finished event position growth dragged) + posn-window growth dragged) + ;; Decide on whether we are allowed to track at all and whose + ;; window's edge we drag. (cond ((eq line 'header) - ;; Check whether header-line can be dragged at all. (if (window-at-side-p window 'top) + ;; We can't drag the header line of a topmost window. (setq draggable nil) - ;; 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)))) + ;; Drag bottom edge of window above the header line. (setq window (window-in-direction 'above window t)))) ((eq line 'mode) - ;; Check whether mode-line can be dragged at all. (if (and (window-at-side-p window 'bottom) - ;; Allow resizing the minibuffer window if it's on the same - ;; frame as and immediately below the clicked window, and - ;; it's active or `resize-mini-windows' is nil. - (not (and (eq (window-frame minibuffer-window) frame) - (= (nth 1 (window-pixel-edges minibuffer-window)) - (nth 3 (window-pixel-edges window))) - (or (not resize-mini-windows) - (eq minibuffer-window - (active-minibuffer-window)))))) - (setq draggable nil) - (setq height + ;; Allow resizing the minibuffer window if it's on the + ;; same frame as and immediately below `window', and it's + ;; either active or `resize-mini-windows' is nil. + (let ((minibuffer-window (minibuffer-window frame))) + (not (and (eq (window-frame minibuffer-window) frame) + (or (not resize-mini-windows) + (eq minibuffer-window + (active-minibuffer-window))))))) + (setq draggable nil)))) + + (let* ((exitfun nil) + (move + (lambda (event) (interactive "e") (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, - ;; adjust the window where the start-event occurred. If the - ;; scroll bar is on the start-event window's left or there are no - ;; scrollbars, adjust the window on the left of it. - (unless (or (eq side 'right) - (not (zerop (window-right-divider-width window)))) - (setq window (window-in-direction 'left window t))))) - - ;; Start tracking. - (track-mouse + ((not (consp event)) + nil) + ((eq line 'vertical) + ;; Drag right edge of `window'. + (setq start (event-start event)) + (setq position (car (posn-x-y start))) + ;; Set `posn-window' to the window where `event' was recorded. + ;; This can be `window' or the window on the left or right of + ;; `window'. + (when (window-live-p (setq posn-window (posn-window start))) + ;; Add left edge of `posn-window' to `position'. + (setq position (+ (window-pixel-left posn-window) position)) + (unless (nth 1 start) + ;; Add width of objects on the left of the text area to + ;; `position'. + (when (eq (window-current-scroll-bars posn-window) 'left) + (setq position (+ (window-scroll-bar-width posn-window) + position))) + (setq position (+ (car (window-fringes posn-window)) + (or (car (window-margins posn-window)) 0) + position)))) + ;; When the cursor overshoots after shrinking a window to its + ;; minimum size and the dragging direction changes, have the + ;; cursor first catch up with the window edge. + (unless (or (zerop (setq growth (- position last-position))) + (and (> growth 0) + (< position (+ (window-pixel-left window) + (window-pixel-width window)))) + (and (< growth 0) + (> position (+ (window-pixel-left window) + (window-pixel-width window))))) + (setq dragged t) + (adjust-window-trailing-edge window growth t t)) + (setq last-position position)) + (draggable + ;; Drag bottom edge of `window'. + (setq start (event-start event)) + ;; Set `posn-window' to the window where `event' was recorded. + ;; This can be either `window' or the window above or below of + ;; `window'. + (setq posn-window (posn-window start)) + (setq position (cdr (posn-x-y start))) + (when (window-live-p posn-window) + ;; Add top edge of `posn-window' to `position'. + (setq position (+ (window-pixel-top posn-window) position)) + ;; If necessary, add height of header line to `position' + (when (memq (posn-area start) + '(nil left-fringe right-fringe left-margin right-margin)) + (setq position (+ (window-header-line-height posn-window) position)))) + ;; When the cursor overshoots after shrinking a window to its + ;; minimum size and the dragging direction changes, have the + ;; cursor first catch up with the window edge. + (unless (or (zerop (setq growth (- position last-position))) + (and (> growth 0) + (< position (+ (window-pixel-top window) + (window-pixel-height window)))) + (and (< growth 0) + (> position (+ (window-pixel-top window) + (window-pixel-height window))))) + (setq dragged t) + (adjust-window-trailing-edge window growth nil t)) + (setq last-position position)))))) + ;; Start tracking. + (setq track-mouse t) ;; Loop reading events and sampling the position of the mouse. - (while (not finished) - (setq event (read-event)) - (setq position (mouse-pixel-position)) - ;; Do nothing if - ;; - there is a switch-frame event. - ;; - the mouse isn't in the frame that we started in - ;; - the mouse isn't in any Emacs frame - ;; Drag if - ;; - there is a mouse-movement event - ;; - there is a scroll-bar-movement event (Why? -- cyd) - ;; (same as mouse movement for our purposes) - ;; Quit if - ;; - there is a keyboard event or some other unknown event. - (cond - ((not (consp event)) - (setq finished t)) - ((memq (car event) '(switch-frame select-window)) - nil) - ((not (memq (car event) '(mouse-movement scroll-bar-movement))) - (when (consp event) - ;; Do not unread a drag-mouse-1 event to avoid selecting - ;; some other window. For vertical line dragging do not - ;; unread mouse-1 events either (but only if we dragged at - ;; least once to allow mouse-1 clicks get through). - (unless (and dragged - (if (eq line 'vertical) - (memq (car event) '(drag-mouse-1 mouse-1)) - (eq (car event) 'drag-mouse-1))) - (push event unread-command-events))) - (setq finished t)) - ((not (and (eq (car position) frame) - (cadr position))) - nil) - ((eq line 'vertical) - ;; Drag vertical divider. This must be probably fixed like - ;; for the mode-line. - (setq growth (- (cadr position) - (if (eq side 'right) 0 2) - (nth 2 (window-pixel-edges window)) - -1)) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge window growth t t))) - (draggable - ;; Drag horizontal divider. - (setq growth - (if (eq line 'mode) - (- (+ (cddr position) height) - (nth 3 (window-pixel-edges window))) - ;; The window's top includes the header line! - (- (+ (nth 3 (window-pixel-edges window)) height) - (cddr position)))) - (unless (zerop growth) - (setq dragged t) - (adjust-window-trailing-edge - window (if (eq line 'mode) growth (- growth)) nil t)))))))) + (setq exitfun + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [scroll-bar-movement] #'ignore) + (define-key map [mouse-movement] move) + ;; Swallow drag-mouse-1 events to avoid selecting some other window. + (define-key map [drag-mouse-1] + (lambda () (interactive) (funcall exitfun))) + ;; For vertical line dragging swallow also a mouse-1 + ;; event (but only if we dragged at least once to allow mouse-1 + ;; clicks to get through). + (when (eq line 'vertical) + (define-key map [mouse-1] + `(menu-item "" ,(lambda () (interactive) (funcall exitfun)) + :filter ,(lambda (cmd) (if dragged cmd))))) + ;; Some of the events will of course end up looked up + ;; with a mode-line or header-line prefix ... + (define-key map [mode-line] map) + (define-key map [header-line] map) + ;; ... and some maybe even with a right- or bottom-divider + ;; prefix. + (define-key map [right-divider] map) + (define-key map [bottom-divider] map) + map) + t (lambda () (setq track-mouse nil))))))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." @@ -509,14 +511,18 @@ must be one of the symbols `header', `mode', or `vertical'." (interactive "e") (mouse-drag-line start-event 'vertical)) -(defun mouse-set-point (event) +(defun mouse-set-point (event &optional promote-to-region) "Move point to the position clicked on with the mouse. -This should be bound to a mouse click event type." - (interactive "e") +This should be bound to a mouse click event type. +If PROMOTE-TO-REGION is non-nil and event is a multiple-click, +select the corresponding element around point." + (interactive "e\np") (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. - (posn-set-point (event-end event))) + (if (and promote-to-region (> (event-click-count event) 1)) + (mouse-set-region event) + ;; Use event-end in case called from mouse-drag-region. + ;; If EVENT is a click, event-end and event-start give same value. + (posn-set-point (event-end event)))) (defvar mouse-last-region-beg nil) (defvar mouse-last-region-end nil) @@ -529,6 +535,8 @@ This should be bound to a mouse click event type." (eq mouse-last-region-end (region-end)) (eq mouse-last-region-tick (buffer-modified-tick)))) +(defvar mouse--drag-start-event nil) + (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. @@ -538,7 +546,29 @@ command alters the kill ring or not." (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 (posn-point (event-end click))) + (click-count (event-click-count click))) + (let ((drag-start (terminal-parameter nil 'mouse-drag-start))) + (when drag-start + ;; Drag events don't come with a click count, sadly, so we hack + ;; our way around this problem by remembering the start-event in + ;; `mouse-drag-start' and fetching the click-count from there. + (when (and (<= click-count 1) + (equal beg (posn-point (event-start drag-start)))) + (setq click-count (event-click-count drag-start))) + ;; Occasionally we get spurious drag events where the user hasn't + ;; dragged his mouse, but instead Emacs has dragged the text under the + ;; user's mouse. Try to recover those cases (bug#17562). + (when (and (equal (posn-x-y (event-start click)) + (posn-x-y (event-end click))) + (not (eq (car drag-start) 'mouse-movement))) + (setq end beg)) + (setf (terminal-parameter nil 'mouse-drag-start) nil))) + (when (and (integerp beg) (integerp end)) + (let ((range (mouse-start-end beg end (1- click-count)))) + (if (< end beg) + (setq end (nth 0 range) beg (nth 1 range)) + (setq beg (nth 0 range) end (nth 1 range))))) (and mouse-drag-copy-region (integerp beg) (integerp end) ;; Don't set this-command to `kill-region', so a following ;; C-w won't double the text in the kill ring. Ignore @@ -558,10 +588,10 @@ command alters the kill ring or not." (defun mouse-set-region-1 () ;; Set transient-mark-mode for a little while. (unless (eq (car-safe transient-mark-mode) 'only) - (setq transient-mark-mode - (cons 'only - (unless (eq transient-mark-mode 'lambda) - transient-mark-mode)))) + (setq-local transient-mark-mode + (cons 'only + (unless (eq transient-mark-mode 'lambda) + transient-mark-mode)))) (setq mouse-last-region-beg (region-beginning)) (setq mouse-last-region-end (region-end)) (setq mouse-last-region-tick (buffer-modified-tick))) @@ -632,13 +662,11 @@ Upon exit, point is at the far edge of the newly visible text." 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. - -If the click is in the echo area, display the `*Messages*' buffer." +remains active. Otherwise, it remains until the next input event." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) - (mouse-drag-track start-event t)) + (mouse-drag-track start-event)) (defun mouse-posn-property (pos property) @@ -655,10 +683,11 @@ its value is returned." (str (posn-string pos))) (or (and str (get-text-property (cdr str) property (car str))) - ;; 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))) + ;; Mouse clicks in the fringe come with a position in + ;; (nth 5). This is useful but is not exactly where we clicked, so + ;; don't look up that position's properties! + (and pt (not (memq (posn-area pos) '(left-fringe right-fringe + left-margin right-margin))) (get-char-property pt property w)))) (get-char-property pos property))) @@ -745,12 +774,9 @@ at the same position." "mouse-1" (substring msg 7))))))) msg) -(defun mouse-drag-track (start-event &optional - do-mouse-drag-region-post-process) +(defun mouse-drag-track (start-event) "Track mouse drags by highlighting area between point and cursor. -The region will be defined with mark and point. -DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by -`mouse-drag-region'." +The region will be defined with mark and point." (mouse-minibuffer-check start-event) (setq mouse-selection-click-count-buffer (current-buffer)) (deactivate-mark) @@ -763,8 +789,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (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-hscroll (window-hscroll start-window)) (bounds (window-edges start-window)) (make-cursor-line-fully-visible nil) (top (nth 1 bounds)) @@ -775,9 +799,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (click-count (1- (event-click-count start-event))) ;; Suppress automatic hscrolling, because that is a nuisance ;; when setting point near the right fringe (but see below). - (auto-hscroll-mode-saved auto-hscroll-mode) - (auto-hscroll-mode nil) - moved-off-start event end end-point) + (auto-hscroll-mode-saved auto-hscroll-mode)) (setq mouse-selection-click-count click-count) ;; In case the down click is in the middle of some intangible text, @@ -788,93 +810,51 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by ;; Activate the region, using `mouse-start-end' to determine where ;; to put point and mark (e.g., double-click will select a word). - (setq transient-mark-mode - (if (eq transient-mark-mode 'lambda) - '(only) - (cons 'only transient-mark-mode))) + (setq-local transient-mark-mode + (if (eq transient-mark-mode 'lambda) + '(only) + (cons 'only transient-mark-mode))) (let ((range (mouse-start-end start-point start-point click-count))) (push-mark (nth 0 range) t t) (goto-char (nth 1 range))) - ;; Track the mouse until we get a non-movement event. - (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (memq (car-safe event) '(switch-frame select-window)))) - (unless (memq (car-safe event) '(switch-frame select-window)) - ;; Automatic hscrolling did not occur during the call to - ;; `read-event'; but if the user subsequently drags the - ;; mouse, go ahead and hscroll. - (let ((auto-hscroll-mode auto-hscroll-mode-saved)) - (redisplay)) - (setq end (event-end event) - end-point (posn-point end)) - ;; Note whether the mouse has left the starting position. - (unless (eq end-point start-point) - (setq moved-off-start t)) - (if (and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - (mouse--drag-set-mark-and-point start-point - end-point click-count) - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top) - nil start-point)) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) - nil start-point)))))))) - - ;; Handle the terminating event if possible. - (when (consp event) - ;; Ensure that point is on the end of the last event. - (when (and (setq end-point (posn-point (event-end event))) - (eq (posn-window end) start-window) - (integer-or-marker-p end-point) - (/= start-point end-point)) - (mouse--drag-set-mark-and-point start-point - end-point click-count)) - - ;; Find its binding. - (let* ((fun (key-binding (vector (car event)))) - ;; FIXME This doesn't make sense, because - ;; event-click-count always returns something >= 1. - (do-multi-click (and (> (event-click-count event) 0) - (functionp fun) - (not (memq fun '(mouse-set-point - mouse-set-region)))))) - (if (and (/= (mark) (point)) - (not do-multi-click)) - - ;; If point has moved, finish the drag. - (let* (last-command this-command) - (and mouse-drag-copy-region - do-mouse-drag-region-post-process - (let (deactivate-mark) - (copy-region-as-kill (mark) (point))))) - - ;; Otherwise, run binding of terminating up-event. + (setf (terminal-parameter nil 'mouse-drag-start) start-event) + (setq track-mouse t) + (setq auto-hscroll-mode nil) + + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] + (lambda (event) (interactive "e") + (let* ((end (event-end event)) + (end-point (posn-point end))) + (unless (eq end-point start-point) + ;; As soon as the user moves, we can re-enable auto-hscroll. + (setq auto-hscroll-mode auto-hscroll-mode-saved) + ;; And remember that we have moved, so mouse-set-region can know + ;; its event is really a drag event. + (setcar start-event 'mouse-movement)) + (if (and (eq (posn-window end) start-window) + (integer-or-marker-p end-point)) + (mouse--drag-set-mark-and-point start-point + end-point click-count) + (let ((mouse-row (cdr (cdr (mouse-position))))) + (cond + ((null mouse-row)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top) + nil start-point)) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) + nil start-point)))))))) + map) + t (lambda () + (setq track-mouse nil) + (setq auto-hscroll-mode auto-hscroll-mode-saved) (deactivate-mark) - (if do-multi-click - (goto-char start-point) - (unless moved-off-start - (pop-mark))) - - (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 - ;; contains a different position due to the new - ;; window contents, and point is set again. - (or end-point - (= (window-start start-window) - start-window-start))) - (push event unread-command-events))))))) + (pop-mark))))) (defun mouse--drag-set-mark-and-point (start click click-count) (let* ((range (mouse-start-end start click click-count)) @@ -1089,24 +1069,7 @@ regardless of where you click." (let (select-active-regions) (deactivate-mark))) (or mouse-yank-at-point (mouse-set-point click)) - (let ((primary - (if (fboundp 'x-get-selection-value) - (if (eq (framep (selected-frame)) 'w32) - ;; 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)) - ;; Else MS-DOS or 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.? - (x-get-selection 'PRIMARY)))) - (unless primary - (error "No selection is available")) + (let ((primary (gui-get-primary-selection))) (push-mark (point)) (insert-for-yank primary))) @@ -1293,7 +1256,7 @@ This must be bound to a mouse drag event." (if (numberp (posn-point posn)) (setq beg (posn-point posn))) (move-overlay mouse-secondary-overlay beg (posn-point end)) - (x-set-selection + (gui-set-selection 'SECONDARY (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay)))))) @@ -1330,6 +1293,7 @@ The function returns a non-nil value if it creates a secondary selection." (setq mouse-secondary-start (make-marker))) (set-marker mouse-secondary-start start-point) (delete-overlay mouse-secondary-overlay)) + ;; FIXME: Use mouse-drag-track! (let (event end end-point) (track-mouse (while (progn @@ -1368,13 +1332,13 @@ The function returns a non-nil value if it creates a secondary selection." (if (marker-position mouse-secondary-start) (save-window-excursion (delete-overlay mouse-secondary-overlay) - (x-set-selection 'SECONDARY nil) + (gui-set-selection 'SECONDARY nil) (select-window start-window) (save-excursion (goto-char mouse-secondary-start) (sit-for 1) nil)) - (x-set-selection + (gui-set-selection 'SECONDARY (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))))))))) @@ -1388,7 +1352,7 @@ regardless of where you click." ;; 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 ((secondary (x-get-selection 'SECONDARY))) + (let ((secondary (gui-get-selection 'SECONDARY))) (if secondary (insert-for-yank secondary) (error "No secondary selection")))) @@ -1507,7 +1471,7 @@ CLICK position, kill the secondary selection." (setq str (buffer-substring (overlay-start mouse-secondary-overlay) (overlay-end mouse-secondary-overlay))) (> (length str) 0) - (x-set-selection 'SECONDARY str)))) + (gui-set-selection 'SECONDARY str)))) (defcustom mouse-buffer-menu-maxlen 20 @@ -1552,8 +1516,17 @@ This switches buffers in the window that you clicked on, and selects that window." (interactive "e") (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 ((buf (x-popup-menu event (mouse-buffer-menu-map))) + (window (posn-window (event-start event)))) + (when buf + (select-window + (if (framep window) (frame-selected-window window) + window)) + (switch-to-buffer buf)))) + +(defun mouse-buffer-menu-map () + ;; Make an alist of elements that look like (MENU-ITEM . BUFFER). + (let ((buffers (buffer-list)) split-by-major-mode sum-of-squares) (dolist (buf buffers) ;; Divide all buffers into buckets for various major modes. ;; Each bucket looks like (MODE NAMESTRING BUFFERS...). @@ -1617,18 +1590,10 @@ and selects that window." (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)) - (setq menu (cons "Buffer Menu" - (mouse-buffer-menu-split "Select Buffer" alist))))) - (let ((buf (x-popup-menu event menu)) - (window (posn-window (event-start event)))) - (when buf - (select-window - (if (framep window) (frame-selected-window window) - window)) - (switch-to-buffer buf))))) + (cons "Buffer Menu" (nreverse subdivided-menus))) + (cons "Buffer Menu" + (mouse-buffer-menu-split "Select Buffer" + (mouse-buffer-menu-alist buffers)))))) (defun mouse-buffer-menu-alist (buffers) (let (tail @@ -1902,14 +1867,10 @@ choose a font." ;;; Bindings for mouse commands. -(define-key global-map [down-mouse-1] 'mouse-drag-region) +(global-set-key [down-mouse-1] 'mouse-drag-region) (global-set-key [mouse-1] 'mouse-set-point) (global-set-key [drag-mouse-1] 'mouse-set-region) -;; These are tested for in mouse-drag-region. -(global-set-key [double-mouse-1] 'mouse-set-point) -(global-set-key [triple-mouse-1] 'mouse-set-point) - (defun mouse--strip-first-event (_prompt) (substring (this-single-command-raw-keys) 1)) |