Line data Source code
1 : ;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1993-1995, 1999-2017 Free Software Foundation, Inc.
4 :
5 : ;; Maintainer: emacs-devel@gnu.org
6 : ;; Keywords: hardware, mouse
7 : ;; Package: emacs
8 :
9 : ;; This file is part of GNU Emacs.
10 :
11 : ;; GNU Emacs is free software: you can redistribute it and/or modify
12 : ;; it under the terms of the GNU General Public License as published by
13 : ;; the Free Software Foundation, either version 3 of the License, or
14 : ;; (at your option) any later version.
15 :
16 : ;; GNU Emacs is distributed in the hope that it will be useful,
17 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 : ;; GNU General Public License for more details.
20 :
21 : ;; You should have received a copy of the GNU General Public License
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; This package provides various useful commands (including help
27 : ;; system access) through the mouse. All this code assumes that mouse
28 : ;; interpretation has been abstracted into Emacs input events.
29 :
30 : ;;; Code:
31 :
32 : ;;; Utility functions.
33 :
34 : ;; Indent track-mouse like progn.
35 : (put 'track-mouse 'lisp-indent-function 0)
36 :
37 : (defgroup mouse nil
38 : "Input from the mouse." ;; "Mouse support."
39 : :group 'environment
40 : :group 'editing)
41 :
42 : (defcustom mouse-yank-at-point nil
43 : "If non-nil, mouse yank commands yank at point instead of at click."
44 : :type 'boolean
45 : :group 'mouse)
46 :
47 : (defcustom mouse-drag-copy-region nil
48 : "If non-nil, copy to kill-ring upon mouse adjustments of the region.
49 :
50 : This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
51 : addition to mouse drags."
52 : :type 'boolean
53 : :version "24.1"
54 : :group 'mouse)
55 :
56 : (defcustom mouse-1-click-follows-link 450
57 : "Non-nil means that clicking Mouse-1 on a link follows the link.
58 :
59 : With the default setting, an ordinary Mouse-1 click on a link
60 : performs the same action as Mouse-2 on that link, while a longer
61 : Mouse-1 click \(hold down the Mouse-1 button for more than 450
62 : milliseconds) performs the original Mouse-1 binding \(which
63 : typically sets point where you click the mouse).
64 :
65 : If value is an integer, the time elapsed between pressing and
66 : releasing the mouse button determines whether to follow the link
67 : or perform the normal Mouse-1 action (typically set point).
68 : The absolute numeric value specifies the maximum duration of a
69 : \"short click\" in milliseconds. A positive value means that a
70 : short click follows the link, and a longer click performs the
71 : normal action. A negative value gives the opposite behavior.
72 :
73 : If value is `double', a double click follows the link.
74 :
75 : Otherwise, a single Mouse-1 click unconditionally follows the link.
76 :
77 : Note that dragging the mouse never follows the link.
78 :
79 : This feature only works in modes that specifically identify
80 : clickable text as links, so it may not work with some external
81 : packages. See `mouse-on-link-p' for details."
82 : :version "22.1"
83 : :type '(choice (const :tag "Disabled" nil)
84 : (const :tag "Double click" double)
85 : (number :tag "Single click time limit" :value 450)
86 : (other :tag "Single click" t))
87 : :group 'mouse)
88 :
89 : (defcustom mouse-1-click-in-non-selected-windows t
90 : "If non-nil, a Mouse-1 click also follows links in non-selected windows.
91 :
92 : If nil, a Mouse-1 click on a link in a non-selected window performs
93 : the normal mouse-1 binding, typically selects the window and sets
94 : point at the click position."
95 : :type 'boolean
96 : :version "22.1"
97 : :group 'mouse)
98 :
99 : (defun mouse--down-1-maybe-follows-link (&optional _prompt)
100 : "Turn `mouse-1' events into `mouse-2' events if follows-link.
101 : Expects to be bound to `down-mouse-1' in `key-translation-map'."
102 0 : (when (and mouse-1-click-follows-link
103 0 : (eq (if (eq mouse-1-click-follows-link 'double)
104 0 : 'double-down-mouse-1 'down-mouse-1)
105 0 : (car-safe last-input-event)))
106 0 : (let ((action (mouse-on-link-p (event-start last-input-event))))
107 0 : (when (and action
108 0 : (or mouse-1-click-in-non-selected-windows
109 0 : (eq (selected-window)
110 0 : (posn-window (event-start last-input-event)))))
111 0 : (let ((timedout
112 0 : (sit-for (if (numberp mouse-1-click-follows-link)
113 0 : (/ (abs mouse-1-click-follows-link) 1000.0)
114 0 : 0))))
115 0 : (if (if (and (numberp mouse-1-click-follows-link)
116 0 : (>= mouse-1-click-follows-link 0))
117 0 : timedout (not timedout))
118 : nil
119 : ;; Use read-key so it works for xterm-mouse-mode!
120 0 : (let ((event (read-key)))
121 0 : (if (eq (car-safe event)
122 0 : (if (eq mouse-1-click-follows-link 'double)
123 0 : 'double-mouse-1 'mouse-1))
124 0 : (progn
125 : ;; Turn the mouse-1 into a mouse-2 to follow links,
126 : ;; but only if ‘mouse-on-link-p’ hasn’t returned a
127 : ;; string or vector (see its docstring).
128 0 : (if (or (stringp action) (vectorp action))
129 0 : (push (aref action 0) unread-command-events)
130 0 : (let ((newup (if (eq mouse-1-click-follows-link 'double)
131 0 : 'double-mouse-2 'mouse-2)))
132 : ;; If mouse-2 has never been done by the user, it
133 : ;; doesn't have the necessary property to be
134 : ;; interpreted correctly.
135 0 : (unless (get newup 'event-kind)
136 0 : (put newup 'event-kind (get (car event) 'event-kind)))
137 0 : (push (cons newup (cdr event)) unread-command-events)))
138 : ;; Don't change the down event, only the up-event
139 : ;; (bug#18212).
140 0 : nil)
141 0 : (push event unread-command-events)
142 0 : nil))))))))
143 :
144 : (define-key key-translation-map [down-mouse-1]
145 : #'mouse--down-1-maybe-follows-link)
146 : (define-key key-translation-map [double-down-mouse-1]
147 : #'mouse--down-1-maybe-follows-link)
148 :
149 :
150 : ;; Provide a mode-specific menu on a mouse button.
151 :
152 : (defun minor-mode-menu-from-indicator (indicator)
153 : "Show menu for minor mode specified by INDICATOR.
154 : Interactively, INDICATOR is read using completion.
155 : If there is no menu defined for the minor mode, then create one with
156 : items `Turn Off' and `Help'."
157 : (interactive
158 0 : (list (completing-read
159 : "Minor mode indicator: "
160 0 : (describe-minor-mode-completion-table-for-indicator))))
161 0 : (let* ((minor-mode (lookup-minor-mode-from-indicator indicator))
162 0 : (mm-fun (or (get minor-mode :minor-mode-function) minor-mode)))
163 0 : (unless minor-mode (error "Cannot find minor mode for `%s'" indicator))
164 0 : (let* ((map (cdr-safe (assq minor-mode minor-mode-map-alist)))
165 0 : (menu (and (keymapp map) (lookup-key map [menu-bar]))))
166 0 : (setq menu
167 0 : (if menu
168 0 : (mouse-menu-non-singleton menu)
169 0 : (if (fboundp mm-fun) ; bug#20201
170 0 : `(keymap
171 0 : ,indicator
172 0 : (turn-off menu-item "Turn off minor mode" ,mm-fun)
173 : (help menu-item "Help for minor mode"
174 : (lambda () (interactive)
175 0 : (describe-function ',mm-fun)))))))
176 0 : (if menu
177 0 : (popup-menu menu)
178 0 : (message "No menu available")))))
179 :
180 : (defun mouse-minor-mode-menu (event)
181 : "Show minor-mode menu for EVENT on minor modes area of the mode line."
182 : (interactive "@e")
183 0 : (let ((indicator (car (nth 4 (car (cdr event))))))
184 0 : (minor-mode-menu-from-indicator indicator)))
185 :
186 : (defun mouse-menu-major-mode-map ()
187 0 : (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
188 0 : (let* (;; Keymap from which to inherit; may be null.
189 0 : (ancestor (mouse-menu-non-singleton
190 0 : (and (current-local-map)
191 0 : (local-key-binding [menu-bar]))))
192 : ;; Make a keymap in which our last command leads to a menu or
193 : ;; default to the edit menu.
194 0 : (newmap (if ancestor
195 0 : (make-sparse-keymap (concat (format-mode-line mode-name)
196 0 : " Mode"))
197 0 : menu-bar-edit-menu)))
198 0 : (if ancestor
199 0 : (set-keymap-parent newmap ancestor))
200 0 : newmap))
201 :
202 : (defun mouse-menu-non-singleton (menubar)
203 : "Return menu keybar MENUBAR, or a lone submenu inside it.
204 : If MENUBAR defines exactly one submenu, return just that submenu.
205 : Otherwise, return MENUBAR."
206 0 : (if menubar
207 0 : (let (submap)
208 0 : (map-keymap
209 0 : (lambda (k v) (setq submap (if submap t (cons k v))))
210 0 : (keymap-canonicalize menubar))
211 0 : (if (eq submap t)
212 0 : menubar
213 0 : (lookup-key menubar (vector (car submap)))))))
214 :
215 : (defun mouse-menu-bar-map ()
216 : "Return a keymap equivalent to the menu bar.
217 : The contents are the items that would be in the menu bar whether or
218 : not it is actually displayed."
219 0 : (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
220 0 : (let* ((local-menu (and (current-local-map)
221 0 : (lookup-key (current-local-map) [menu-bar])))
222 0 : (global-menu (lookup-key global-map [menu-bar]))
223 : ;; If a keymap doesn't have a prompt string (a lazy
224 : ;; programmer didn't bother to provide one), create it and
225 : ;; insert it into the keymap; each keymap gets its own
226 : ;; prompt. This is required for non-toolkit versions to
227 : ;; display non-empty menu pane names.
228 : (minor-mode-menus
229 0 : (mapcar
230 : (lambda (menu)
231 0 : (let* ((minor-mode (car menu))
232 0 : (menu (cdr menu))
233 0 : (title-or-map (cadr menu)))
234 0 : (or (stringp title-or-map)
235 0 : (setq menu
236 0 : (cons 'keymap
237 0 : (cons (concat
238 0 : (capitalize (subst-char-in-string
239 0 : ?- ?\s (symbol-name
240 0 : minor-mode)))
241 0 : " Menu")
242 0 : (cdr menu)))))
243 0 : menu))
244 0 : (minor-mode-key-binding [menu-bar])))
245 0 : (local-title-or-map (and local-menu (cadr local-menu)))
246 0 : (global-title-or-map (cadr global-menu)))
247 0 : (or (null local-menu)
248 0 : (stringp local-title-or-map)
249 0 : (setq local-menu (cons 'keymap
250 0 : (cons (concat (format-mode-line mode-name)
251 0 : " Mode Menu")
252 0 : (cdr local-menu)))))
253 0 : (or (stringp global-title-or-map)
254 0 : (setq global-menu (cons 'keymap
255 0 : (cons "Global Menu"
256 0 : (cdr global-menu)))))
257 : ;; Supplying the list is faster than making a new map.
258 : ;; FIXME: We have a problem here: we have to use the global/local/minor
259 : ;; so they're displayed in the expected order, but later on in the command
260 : ;; loop, they're actually looked up in the opposite order.
261 0 : (apply 'append
262 0 : global-menu
263 0 : local-menu
264 0 : minor-mode-menus)))
265 :
266 : (defun mouse-major-mode-menu (event &optional prefix)
267 : "Pop up a mode-specific menu of mouse commands.
268 : Default to the Edit menu if the major mode doesn't define a menu."
269 : (declare (obsolete mouse-menu-major-mode-map "23.1"))
270 : (interactive "@e\nP")
271 0 : (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
272 0 : (popup-menu (mouse-menu-major-mode-map) event prefix))
273 :
274 : (defun mouse-popup-menubar (event prefix)
275 : "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
276 : The contents are the items that would be in the menu bar whether or
277 : not it is actually displayed."
278 : (declare (obsolete mouse-menu-bar-map "23.1"))
279 : (interactive "@e \nP")
280 0 : (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
281 0 : (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix))
282 :
283 : (defun mouse-popup-menubar-stuff (event prefix)
284 : "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
285 : Use the former if the menu bar is showing, otherwise the latter."
286 : (declare (obsolete nil "23.1"))
287 : (interactive "@e\nP")
288 0 : (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
289 0 : (popup-menu
290 0 : (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
291 0 : (mouse-menu-bar-map)
292 0 : (mouse-menu-major-mode-map))
293 0 : event prefix))
294 :
295 : ;; Commands that operate on windows.
296 :
297 : (defun mouse-minibuffer-check (event)
298 0 : (let ((w (posn-window (event-start event))))
299 0 : (and (window-minibuffer-p w)
300 0 : (not (minibuffer-window-active-p w))
301 0 : (user-error "Minibuffer window is not active")))
302 : ;; Give temporary modes such as isearch a chance to turn off.
303 0 : (run-hooks 'mouse-leave-buffer-hook))
304 :
305 : (defun mouse-delete-window (click)
306 : "Delete the window you click on.
307 : Do nothing if the frame has just one window.
308 : This command must be bound to a mouse click."
309 : (interactive "e")
310 0 : (unless (one-window-p t)
311 0 : (mouse-minibuffer-check click)
312 0 : (delete-window (posn-window (event-start click)))))
313 :
314 : (defun mouse-select-window (click)
315 : "Select the window clicked on; don't move point."
316 : (interactive "e")
317 0 : (mouse-minibuffer-check click)
318 0 : (let ((oframe (selected-frame))
319 0 : (frame (window-frame (posn-window (event-start click)))))
320 0 : (select-window (posn-window (event-start click)))
321 0 : (raise-frame frame)
322 0 : (select-frame frame)
323 0 : (or (eq frame oframe)
324 0 : (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
325 :
326 : (define-obsolete-function-alias 'mouse-tear-off-window 'tear-off-window "24.4")
327 : (defun tear-off-window (click)
328 : "Delete the selected window, and create a new frame displaying its buffer."
329 : (interactive "e")
330 0 : (mouse-minibuffer-check click)
331 0 : (let* ((window (posn-window (event-start click)))
332 0 : (buf (window-buffer window))
333 0 : (frame (make-frame))) ;FIXME: Use pop-to-buffer.
334 0 : (select-frame frame)
335 0 : (switch-to-buffer buf)
336 0 : (delete-window window)))
337 :
338 : (defun mouse-delete-other-windows ()
339 : "Delete all windows except the one you click on."
340 : (interactive "@")
341 0 : (delete-other-windows))
342 :
343 : (defun mouse-split-window-vertically (click)
344 : "Select Emacs window mouse is on, then split it vertically in half.
345 : The window is split at the line clicked on.
346 : This command must be bound to a mouse click."
347 : (interactive "@e")
348 0 : (mouse-minibuffer-check click)
349 0 : (let ((start (event-start click)))
350 0 : (select-window (posn-window start))
351 0 : (let ((new-height (1+ (cdr (posn-col-row (event-end click)))))
352 0 : (first-line window-min-height)
353 0 : (last-line (- (window-height) window-min-height)))
354 0 : (if (< last-line first-line)
355 0 : (user-error "Window too short to split")
356 : ;; Bind `window-combination-resize' to nil so we are sure to get
357 : ;; the split right at the line clicked on.
358 0 : (let (window-combination-resize)
359 0 : (split-window-vertically
360 0 : (min (max new-height first-line) last-line)))))))
361 :
362 : (defun mouse-split-window-horizontally (click)
363 : "Select Emacs window mouse is on, then split it horizontally in half.
364 : The window is split at the column clicked on.
365 : This command must be bound to a mouse click."
366 : (interactive "@e")
367 0 : (mouse-minibuffer-check click)
368 0 : (let ((start (event-start click)))
369 0 : (select-window (posn-window start))
370 0 : (let ((new-width (1+ (car (posn-col-row (event-end click)))))
371 0 : (first-col window-min-width)
372 0 : (last-col (- (window-width) window-min-width)))
373 0 : (if (< last-col first-col)
374 0 : (user-error "Window too narrow to split")
375 : ;; Bind `window-combination-resize' to nil so we are sure to get
376 : ;; the split right at the column clicked on.
377 0 : (let (window-combination-resize)
378 0 : (split-window-horizontally
379 0 : (min (max new-width first-col) last-col)))))))
380 :
381 : (defun mouse-drag-line (start-event line)
382 : "Drag a mode line, header line, or vertical line with the mouse.
383 : START-EVENT is the starting mouse event of the drag action. LINE
384 : must be one of the symbols `header', `mode', or `vertical'."
385 : ;; Give temporary modes such as isearch a chance to turn off.
386 0 : (run-hooks 'mouse-leave-buffer-hook)
387 0 : (let* ((echo-keystrokes 0)
388 0 : (start (event-start start-event))
389 0 : (window (posn-window start))
390 0 : (frame (window-frame window))
391 : ;; `position' records the x- or y-coordinate of the last
392 : ;; sampled position.
393 0 : (position (if (eq line 'vertical)
394 0 : (+ (window-pixel-left window)
395 0 : (car (posn-x-y start)))
396 0 : (+ (window-pixel-top window)
397 0 : (cdr (posn-x-y start)))))
398 : ;; `last-position' records the x- or y-coordinate of the
399 : ;; previously sampled position. The difference of `position'
400 : ;; and `last-position' determines the size change of WINDOW.
401 0 : (last-position position)
402 : (draggable t)
403 : posn-window growth dragged)
404 : ;; Decide on whether we are allowed to track at all and whose
405 : ;; window's edge we drag.
406 0 : (cond
407 0 : ((eq line 'header)
408 : ;; Drag bottom edge of window above the header line.
409 0 : (setq window (window-in-direction 'above window t)))
410 0 : ((eq line 'mode))
411 0 : ((eq line 'vertical)
412 0 : (let ((divider-width (frame-right-divider-width frame)))
413 0 : (when (and (or (not (numberp divider-width))
414 0 : (zerop divider-width))
415 0 : (eq (frame-parameter frame 'vertical-scroll-bars) 'left))
416 0 : (setq window (window-in-direction 'left window t))))))
417 0 : (let* ((exitfun nil)
418 : (move
419 : (lambda (event) (interactive "e")
420 0 : (cond
421 0 : ((not (consp event))
422 : nil)
423 0 : ((eq line 'vertical)
424 : ;; Drag right edge of `window'.
425 0 : (setq start (event-start event))
426 0 : (setq position (car (posn-x-y start)))
427 : ;; Set `posn-window' to the window where `event' was recorded.
428 : ;; This can be `window' or the window on the left or right of
429 : ;; `window'.
430 0 : (when (window-live-p (setq posn-window (posn-window start)))
431 : ;; Add left edge of `posn-window' to `position'.
432 0 : (setq position (+ (window-pixel-left posn-window) position))
433 0 : (unless (nth 1 start)
434 : ;; Add width of objects on the left of the text area to
435 : ;; `position'.
436 0 : (when (eq (window-current-scroll-bars posn-window) 'left)
437 0 : (setq position (+ (window-scroll-bar-width posn-window)
438 0 : position)))
439 0 : (setq position (+ (car (window-fringes posn-window))
440 0 : (or (car (window-margins posn-window)) 0)
441 0 : position))))
442 : ;; When the cursor overshoots after shrinking a window to its
443 : ;; minimum size and the dragging direction changes, have the
444 : ;; cursor first catch up with the window edge.
445 0 : (unless (or (zerop (setq growth (- position last-position)))
446 0 : (and (> growth 0)
447 0 : (< position (+ (window-pixel-left window)
448 0 : (window-pixel-width window))))
449 0 : (and (< growth 0)
450 0 : (> position (+ (window-pixel-left window)
451 0 : (window-pixel-width window)))))
452 0 : (setq dragged t)
453 0 : (adjust-window-trailing-edge window growth t t))
454 0 : (setq last-position position))
455 0 : (draggable
456 : ;; Drag bottom edge of `window'.
457 0 : (setq start (event-start event))
458 : ;; Set `posn-window' to the window where `event' was recorded.
459 : ;; This can be either `window' or the window above or below of
460 : ;; `window'.
461 0 : (setq posn-window (posn-window start))
462 0 : (setq position (cdr (posn-x-y start)))
463 0 : (when (window-live-p posn-window)
464 : ;; Add top edge of `posn-window' to `position'.
465 0 : (setq position (+ (window-pixel-top posn-window) position))
466 : ;; If necessary, add height of header line to `position'
467 0 : (when (memq (posn-area start)
468 0 : '(nil left-fringe right-fringe left-margin right-margin))
469 0 : (setq position (+ (window-header-line-height posn-window) position))))
470 : ;; When the cursor overshoots after shrinking a window to its
471 : ;; minimum size and the dragging direction changes, have the
472 : ;; cursor first catch up with the window edge.
473 0 : (unless (or (zerop (setq growth (- position last-position)))
474 0 : (and (> growth 0)
475 0 : (< position (+ (window-pixel-top window)
476 0 : (window-pixel-height window))))
477 0 : (and (< growth 0)
478 0 : (> position (+ (window-pixel-top window)
479 0 : (window-pixel-height window)))))
480 0 : (setq dragged t)
481 0 : (adjust-window-trailing-edge window growth nil t))
482 0 : (setq last-position position)))))
483 0 : (old-track-mouse track-mouse))
484 : ;; Start tracking. The special value 'dragging' signals the
485 : ;; display engine to freeze the mouse pointer shape for as long
486 : ;; as we drag.
487 0 : (setq track-mouse 'dragging)
488 : ;; Loop reading events and sampling the position of the mouse.
489 0 : (setq exitfun
490 0 : (set-transient-map
491 0 : (let ((map (make-sparse-keymap)))
492 0 : (define-key map [switch-frame] #'ignore)
493 0 : (define-key map [select-window] #'ignore)
494 0 : (define-key map [scroll-bar-movement] #'ignore)
495 0 : (define-key map [mouse-movement] move)
496 : ;; Swallow drag-mouse-1 events to avoid selecting some other window.
497 0 : (define-key map [drag-mouse-1]
498 0 : (lambda () (interactive) (funcall exitfun)))
499 : ;; For vertical line dragging swallow also a mouse-1
500 : ;; event (but only if we dragged at least once to allow mouse-1
501 : ;; clicks to get through).
502 0 : (when (eq line 'vertical)
503 0 : (define-key map [mouse-1]
504 0 : `(menu-item "" ,(lambda () (interactive) (funcall exitfun))
505 0 : :filter ,(lambda (cmd) (if dragged cmd)))))
506 : ;; Some of the events will of course end up looked up
507 : ;; with a mode-line, header-line or vertical-line prefix ...
508 0 : (define-key map [mode-line] map)
509 0 : (define-key map [header-line] map)
510 0 : (define-key map [vertical-line] map)
511 : ;; ... and some maybe even with a right- or bottom-divider
512 : ;; prefix.
513 0 : (define-key map [right-divider] map)
514 0 : (define-key map [bottom-divider] map)
515 0 : map)
516 0 : t (lambda () (setq track-mouse old-track-mouse)))))))
517 :
518 : (defun mouse-drag-mode-line (start-event)
519 : "Change the height of a window by dragging on its mode line.
520 : START-EVENT is the starting mouse event of the drag action.
521 :
522 : If the drag happens in a mode line on the bottom of a frame and
523 : that frame's `drag-with-mode-line' parameter is non-nil, drag the
524 : frame instead."
525 : (interactive "e")
526 0 : (let* ((start (event-start start-event))
527 0 : (window (posn-window start))
528 0 : (frame (window-frame window)))
529 0 : (cond
530 0 : ((not (window-live-p window)))
531 0 : ((or (not (window-at-side-p window 'bottom))
532 : ;; Allow resizing the minibuffer window if it's on the
533 : ;; same frame as and immediately below `window', and it's
534 : ;; either active or `resize-mini-windows' is nil.
535 0 : (let ((minibuffer-window (minibuffer-window frame)))
536 0 : (and (eq (window-frame minibuffer-window) frame)
537 0 : (or (not resize-mini-windows)
538 0 : (eq minibuffer-window
539 0 : (active-minibuffer-window))))))
540 0 : (mouse-drag-line start-event 'mode))
541 0 : ((and (frame-parameter frame 'drag-with-mode-line)
542 0 : (window-at-side-p window 'bottom)
543 0 : (let ((minibuffer-window (minibuffer-window frame)))
544 0 : (not (eq (window-frame minibuffer-window) frame))))
545 : ;; Drag frame when the window is on the bottom of its frame and
546 : ;; there is no minibuffer window below.
547 0 : (mouse-drag-frame start-event 'move)))))
548 :
549 : (defun mouse-drag-header-line (start-event)
550 : "Change the height of a window by dragging on its header line.
551 : START-EVENT is the starting mouse event of the drag action.
552 :
553 : If the drag happens in a header line on the top of a frame and
554 : that frame's `drag-with-header-line' parameter is non-nil, drag
555 : the frame instead."
556 : (interactive "e")
557 0 : (let* ((start (event-start start-event))
558 0 : (window (posn-window start)))
559 0 : (if (and (window-live-p window)
560 0 : (not (window-at-side-p window 'top)))
561 0 : (mouse-drag-line start-event 'header)
562 0 : (let ((frame (window-frame window)))
563 0 : (when (frame-parameter frame 'drag-with-header-line)
564 0 : (mouse-drag-frame start-event 'move))))))
565 :
566 : (defun mouse-drag-vertical-line (start-event)
567 : "Change the width of a window by dragging on a vertical line.
568 : START-EVENT is the starting mouse event of the drag action."
569 : (interactive "e")
570 0 : (mouse-drag-line start-event 'vertical))
571 :
572 : (defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
573 : "Helper function for `mouse-drag-frame'."
574 0 : (let* ((frame-x-y (frame-position frame))
575 0 : (frame-x (car frame-x-y))
576 0 : (frame-y (cdr frame-x-y))
577 : alist)
578 0 : (if (> x-diff 0)
579 0 : (when x-move
580 0 : (setq x-diff (min x-diff frame-x))
581 0 : (setq x-move (- frame-x x-diff)))
582 0 : (let* ((min-width (frame-windows-min-size frame t nil t))
583 0 : (min-diff (max 0 (- (frame-inner-width frame) min-width))))
584 0 : (setq x-diff (max x-diff (- min-diff)))
585 0 : (when x-move
586 0 : (setq x-move (+ frame-x (- x-diff))))))
587 :
588 0 : (if (> y-diff 0)
589 0 : (when y-move
590 0 : (setq y-diff (min y-diff frame-y))
591 0 : (setq y-move (- frame-y y-diff)))
592 0 : (let* ((min-height (frame-windows-min-size frame nil nil t))
593 0 : (min-diff (max 0 (- (frame-inner-height frame) min-height))))
594 0 : (setq y-diff (max y-diff (- min-diff)))
595 0 : (when y-move
596 0 : (setq y-move (+ frame-y (- y-diff))))))
597 :
598 0 : (unless (zerop x-diff)
599 0 : (when x-move
600 0 : (push `(left . ,x-move) alist))
601 0 : (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
602 0 : alist))
603 0 : (unless (zerop y-diff)
604 0 : (when y-move
605 0 : (push `(top . ,y-move) alist))
606 0 : (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
607 0 : alist))
608 0 : (when alist
609 0 : (modify-frame-parameters frame alist))))
610 :
611 : (defun mouse-drag-frame (start-event part)
612 : "Drag a frame or one of its edges with the mouse.
613 : START-EVENT is the starting mouse event of the drag action. Its
614 : position window denotes the frame that will be dragged.
615 :
616 : PART specifies the part that has been dragged and must be one of
617 : the symbols 'left', 'top', 'right', 'bottom', 'top-left',
618 : 'top-right', 'bottom-left', 'bottom-right' to drag an internal
619 : border or edge. If PART equals 'move', this means to move the
620 : frame with the mouse."
621 : ;; Give temporary modes such as isearch a chance to turn off.
622 0 : (run-hooks 'mouse-leave-buffer-hook)
623 0 : (let* ((echo-keystrokes 0)
624 0 : (start (event-start start-event))
625 0 : (window (posn-window start))
626 : ;; FRAME is the frame to drag.
627 0 : (frame (if (window-live-p window)
628 0 : (window-frame window)
629 0 : window))
630 0 : (width (frame-native-width frame))
631 0 : (height (frame-native-height frame))
632 : ;; PARENT is the parent frame of FRAME or, if FRAME is a
633 : ;; top-level frame, FRAME's workarea.
634 0 : (parent (frame-parent frame))
635 : (parent-edges
636 0 : (if parent
637 0 : `(0 0 ,(frame-native-width parent) ,(frame-native-height parent))
638 0 : (let* ((attributes
639 0 : (car (display-monitor-attributes-list)))
640 0 : (workarea (assq 'workarea attributes)))
641 0 : (and workarea
642 0 : `(,(nth 1 workarea) ,(nth 2 workarea)
643 0 : ,(+ (nth 1 workarea) (nth 3 workarea))
644 0 : ,(+ (nth 2 workarea) (nth 4 workarea)))))))
645 0 : (parent-left (and parent-edges (nth 0 parent-edges)))
646 0 : (parent-top (and parent-edges (nth 1 parent-edges)))
647 0 : (parent-right (and parent-edges (nth 2 parent-edges)))
648 0 : (parent-bottom (and parent-edges (nth 3 parent-edges)))
649 : ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
650 : ;; last sampled mouse position. Note that we sample absolute
651 : ;; mouse positions to avoid that moving the mouse from one
652 : ;; frame into another gets into our way. `last-x' and `last-y'
653 : ;; records the x- and y-coordinates of the previously sampled
654 : ;; position. The differences between `last-x' and `pos-x' as
655 : ;; well as `last-y' and `pos-y' determine the amount the mouse
656 : ;; has been dragged between the last two samples.
657 : pos-x-y pos-x pos-y
658 0 : (last-x-y (mouse-absolute-pixel-position))
659 0 : (last-x (car last-x-y))
660 0 : (last-y (cdr last-x-y))
661 : ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
662 : ;; mouse position when FRAME snapped. As soon as the
663 : ;; difference between `pos-x' and `snap-x' (or `pos-y' and
664 : ;; `snap-y') exceeds the value of FRAME's `snap-width'
665 : ;; parameter, unsnap FRAME (at the respective side). `snap-x'
666 : ;; and `snap-y' nil mean FRAME is currently not snapped.
667 : snap-x snap-y
668 : (exitfun nil)
669 : (move
670 : (lambda (event)
671 : (interactive "e")
672 0 : (when (consp event)
673 0 : (setq pos-x-y (mouse-absolute-pixel-position))
674 0 : (setq pos-x (car pos-x-y))
675 0 : (setq pos-y (cdr pos-x-y))
676 0 : (cond
677 0 : ((eq part 'left)
678 0 : (mouse-resize-frame frame (- last-x pos-x) 0 t))
679 0 : ((eq part 'top)
680 0 : (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
681 0 : ((eq part 'right)
682 0 : (mouse-resize-frame frame (- pos-x last-x) 0))
683 0 : ((eq part 'bottom)
684 0 : (mouse-resize-frame frame 0 (- pos-y last-y)))
685 0 : ((eq part 'top-left)
686 0 : (mouse-resize-frame
687 0 : frame (- last-x pos-x) (- last-y pos-y) t t))
688 0 : ((eq part 'top-right)
689 0 : (mouse-resize-frame
690 0 : frame (- pos-x last-x) (- last-y pos-y) nil t))
691 0 : ((eq part 'bottom-left)
692 0 : (mouse-resize-frame
693 0 : frame (- last-x pos-x) (- pos-y last-y) t))
694 0 : ((eq part 'bottom-right)
695 0 : (mouse-resize-frame
696 0 : frame (- pos-x last-x) (- pos-y last-y)))
697 0 : ((eq part 'move)
698 0 : (let* ((old-position (frame-position frame))
699 0 : (old-left (car old-position))
700 0 : (old-top (cdr old-position))
701 0 : (left (+ old-left (- pos-x last-x)))
702 0 : (top (+ old-top (- pos-y last-y)))
703 : right bottom
704 : ;; `snap-width' (maybe also a yet to be provided
705 : ;; `snap-height') could become floats to handle
706 : ;; proportionality wrt PARENT. We don't do any
707 : ;; checks on this parameter so far.
708 0 : (snap-width (frame-parameter frame 'snap-width)))
709 : ;; Docking and constraining.
710 0 : (when (and (numberp snap-width) parent-edges)
711 0 : (cond
712 : ;; Docking at the left parent edge.
713 0 : ((< pos-x last-x)
714 0 : (cond
715 0 : ((and (> left parent-left)
716 0 : (<= (- left parent-left) snap-width))
717 : ;; Snap when the mouse moved leftward and
718 : ;; FRAME's left edge would end up within
719 : ;; `snap-width' pixels from PARENT's left edge.
720 0 : (setq snap-x pos-x)
721 0 : (setq left parent-left))
722 0 : ((and (<= left parent-left)
723 0 : (<= (- parent-left left) snap-width)
724 0 : snap-x (<= (- snap-x pos-x) snap-width))
725 : ;; Stay snapped when the mouse moved leftward
726 : ;; but not more than `snap-width' pixels from
727 : ;; the time FRAME snapped.
728 0 : (setq left parent-left))
729 : (t
730 : ;; Unsnap when the mouse moved more than
731 : ;; `snap-width' pixels leftward from the time
732 : ;; FRAME snapped.
733 0 : (setq snap-x nil))))
734 0 : ((> pos-x last-x)
735 0 : (setq right (+ left width))
736 0 : (cond
737 0 : ((and (< right parent-right)
738 0 : (<= (- parent-right right) snap-width))
739 : ;; Snap when the mouse moved rightward and
740 : ;; FRAME's right edge would end up within
741 : ;; `snap-width' pixels from PARENT's right edge.
742 0 : (setq snap-x pos-x)
743 0 : (setq left (- parent-right width)))
744 0 : ((and (>= right parent-right)
745 0 : (<= (- right parent-right) snap-width)
746 0 : snap-x (<= (- pos-x snap-x) snap-width))
747 : ;; Stay snapped when the mouse moved rightward
748 : ;; but not more more than `snap-width' pixels
749 : ;; from the time FRAME snapped.
750 0 : (setq left (- parent-right width)))
751 : (t
752 : ;; Unsnap when the mouse moved rightward more
753 : ;; than `snap-width' pixels from the time FRAME
754 : ;; snapped.
755 0 : (setq snap-x nil)))))
756 :
757 0 : (cond
758 0 : ((< pos-y last-y)
759 0 : (cond
760 0 : ((and (> top parent-top)
761 0 : (<= (- top parent-top) snap-width))
762 : ;; Snap when the mouse moved upward and FRAME's
763 : ;; top edge would end up within `snap-width'
764 : ;; pixels from PARENT's top edge.
765 0 : (setq snap-y pos-y)
766 0 : (setq top parent-top))
767 0 : ((and (<= top parent-top)
768 0 : (<= (- parent-top top) snap-width)
769 0 : snap-y (<= (- snap-y pos-y) snap-width))
770 : ;; Stay snapped when the mouse moved upward but
771 : ;; not more more than `snap-width' pixels from
772 : ;; the time FRAME snapped.
773 0 : (setq top parent-top))
774 : (t
775 : ;; Unsnap when the mouse moved upward more than
776 : ;; `snap-width' pixels from the time FRAME
777 : ;; snapped.
778 0 : (setq snap-y nil))))
779 0 : ((> pos-y last-y)
780 0 : (setq bottom (+ top height))
781 0 : (cond
782 0 : ((and (< bottom parent-bottom)
783 0 : (<= (- parent-bottom bottom) snap-width))
784 : ;; Snap when the mouse moved downward and
785 : ;; FRAME's bottom edge would end up within
786 : ;; `snap-width' pixels from PARENT's bottom
787 : ;; edge.
788 0 : (setq snap-y pos-y)
789 0 : (setq top (- parent-bottom height)))
790 0 : ((and (>= bottom parent-bottom)
791 0 : (<= (- bottom parent-bottom) snap-width)
792 0 : snap-y (<= (- pos-y snap-y) snap-width))
793 : ;; Stay snapped when the mouse moved downward
794 : ;; but not more more than `snap-width' pixels
795 : ;; from the time FRAME snapped.
796 0 : (setq top (- parent-bottom height)))
797 : (t
798 : ;; Unsnap when the mouse moved downward more
799 : ;; than `snap-width' pixels from the time FRAME
800 : ;; snapped.
801 0 : (setq snap-y nil))))))
802 :
803 : ;; If requested, constrain FRAME's draggable areas to
804 : ;; PARENT's edges. The `top-visible' parameter should
805 : ;; be set when FRAME has a draggable header-line. If
806 : ;; set to a number, it ascertains that the top of
807 : ;; FRAME is always constrained to the top of PARENT
808 : ;; and that at least as many pixels of FRAME as
809 : ;; specified by that number are visible on each of the
810 : ;; three remaining sides of PARENT.
811 : ;;
812 : ;; The `bottom-visible' parameter should be set when
813 : ;; FRAME has a draggable mode-line. If set to a
814 : ;; number, it ascertains that the bottom of FRAME is
815 : ;; always constrained to the bottom of PARENT and that
816 : ;; at least as many pixels of FRAME as specified by
817 : ;; that number are visible on each of the three
818 : ;; remaining sides of PARENT.
819 0 : (let ((par (frame-parameter frame 'top-visible))
820 : bottom-visible)
821 0 : (unless par
822 0 : (setq par (frame-parameter frame 'bottom-visible))
823 0 : (setq bottom-visible t))
824 0 : (when (and (numberp par) parent-edges)
825 0 : (setq left
826 0 : (max (min (- parent-right par) left)
827 0 : (+ (- parent-left width) par)))
828 0 : (setq top
829 0 : (if bottom-visible
830 0 : (min (max top (- parent-top (- height par)))
831 0 : (- parent-bottom height))
832 0 : (min (max top parent-top)
833 0 : (- parent-bottom par))))))
834 :
835 : ;; Use `modify-frame-parameters' since `left' and
836 : ;; `top' may want to move FRAME out of its PARENT.
837 0 : (modify-frame-parameters
838 0 : frame
839 0 : `((left . (+ ,left)) (top . (+ ,top)))))))
840 0 : (setq last-x pos-x)
841 0 : (setq last-y pos-y))))
842 0 : (old-track-mouse track-mouse))
843 : ;; Start tracking. The special value 'dragging' signals the
844 : ;; display engine to freeze the mouse pointer shape for as long
845 : ;; as we drag.
846 0 : (setq track-mouse 'dragging)
847 : ;; Loop reading events and sampling the position of the mouse.
848 0 : (setq exitfun
849 0 : (set-transient-map
850 0 : (let ((map (make-sparse-keymap)))
851 0 : (define-key map [switch-frame] #'ignore)
852 0 : (define-key map [select-window] #'ignore)
853 0 : (define-key map [scroll-bar-movement] #'ignore)
854 0 : (define-key map [mouse-movement] move)
855 : ;; Swallow drag-mouse-1 events to avoid selecting some other window.
856 0 : (define-key map [drag-mouse-1]
857 0 : (lambda () (interactive) (funcall exitfun)))
858 : ;; Some of the events will of course end up looked up
859 : ;; with a mode-line, header-line or vertical-line prefix ...
860 0 : (define-key map [mode-line] map)
861 0 : (define-key map [header-line] map)
862 0 : (define-key map [vertical-line] map)
863 : ;; ... and some maybe even with a right- or bottom-divider
864 : ;; prefix.
865 0 : (define-key map [right-divider] map)
866 0 : (define-key map [bottom-divider] map)
867 0 : map)
868 0 : t (lambda () (setq track-mouse old-track-mouse))))))
869 :
870 : (defun mouse-drag-left-edge (start-event)
871 : "Drag left edge of a frame with the mouse.
872 : START-EVENT is the starting mouse event of the drag action."
873 : (interactive "e")
874 0 : (mouse-drag-frame start-event 'left))
875 :
876 : (defun mouse-drag-top-left-corner (start-event)
877 : "Drag top left corner of a frame with the mouse.
878 : START-EVENT is the starting mouse event of the drag action."
879 : (interactive "e")
880 0 : (mouse-drag-frame start-event 'top-left))
881 :
882 : (defun mouse-drag-top-edge (start-event)
883 : "Drag top edge of a frame with the mouse.
884 : START-EVENT is the starting mouse event of the drag action."
885 : (interactive "e")
886 0 : (mouse-drag-frame start-event 'top))
887 :
888 : (defun mouse-drag-top-right-corner (start-event)
889 : "Drag top right corner of a frame with the mouse.
890 : START-EVENT is the starting mouse event of the drag action."
891 : (interactive "e")
892 0 : (mouse-drag-frame start-event 'top-right))
893 :
894 : (defun mouse-drag-right-edge (start-event)
895 : "Drag right edge of a frame with the mouse.
896 : START-EVENT is the starting mouse event of the drag action."
897 : (interactive "e")
898 0 : (mouse-drag-frame start-event 'right))
899 :
900 : (defun mouse-drag-bottom-right-corner (start-event)
901 : "Drag bottom right corner of a frame with the mouse.
902 : START-EVENT is the starting mouse event of the drag action."
903 : (interactive "e")
904 0 : (mouse-drag-frame start-event 'bottom-right))
905 :
906 : (defun mouse-drag-bottom-edge (start-event)
907 : "Drag bottom edge of a frame with the mouse.
908 : START-EVENT is the starting mouse event of the drag action."
909 : (interactive "e")
910 0 : (mouse-drag-frame start-event 'bottom))
911 :
912 : (defun mouse-drag-bottom-left-corner (start-event)
913 : "Drag bottom left corner of a frame with the mouse.
914 : START-EVENT is the starting mouse event of the drag action."
915 : (interactive "e")
916 0 : (mouse-drag-frame start-event 'bottom-left))
917 :
918 : (defcustom mouse-select-region-move-to-beginning nil
919 : "Effect of selecting a region extending backward from double click.
920 : Nil means keep point at the position clicked (region end);
921 : non-nil means move point to beginning of region."
922 : :type '(choice (const :tag "Don't move point" nil)
923 : (const :tag "Move point to beginning of region" t))
924 : :group 'mouse
925 : :version "26.1")
926 :
927 : (defun mouse-set-point (event &optional promote-to-region)
928 : "Move point to the position clicked on with the mouse.
929 : This should be bound to a mouse click event type.
930 : If PROMOTE-TO-REGION is non-nil and event is a multiple-click, select
931 : the corresponding element around point, with the resulting position of
932 : point determined by `mouse-select-region-move-to-beginning'."
933 : (interactive "e\np")
934 0 : (mouse-minibuffer-check event)
935 0 : (if (and promote-to-region (> (event-click-count event) 1))
936 0 : (progn
937 0 : (mouse-set-region event)
938 0 : (when mouse-select-region-move-to-beginning
939 0 : (when (> (posn-point (event-start event)) (region-beginning))
940 0 : (exchange-point-and-mark))))
941 : ;; Use event-end in case called from mouse-drag-region.
942 : ;; If EVENT is a click, event-end and event-start give same value.
943 0 : (posn-set-point (event-end event))))
944 :
945 : (defvar mouse-last-region-beg nil)
946 : (defvar mouse-last-region-end nil)
947 : (defvar mouse-last-region-tick nil)
948 :
949 : (defun mouse-region-match ()
950 : "Return non-nil if there's an active region that was set with the mouse."
951 0 : (and (mark t) mark-active
952 0 : (eq mouse-last-region-beg (region-beginning))
953 0 : (eq mouse-last-region-end (region-end))
954 0 : (eq mouse-last-region-tick (buffer-modified-tick))))
955 :
956 : (defvar mouse--drag-start-event nil)
957 :
958 : (defun mouse-set-region (click)
959 : "Set the region to the text dragged over, and copy to kill ring.
960 : This should be bound to a mouse drag event.
961 : See the `mouse-drag-copy-region' variable to control whether this
962 : command alters the kill ring or not."
963 : (interactive "e")
964 0 : (mouse-minibuffer-check click)
965 0 : (select-window (posn-window (event-start click)))
966 0 : (let ((beg (posn-point (event-start click)))
967 : (end
968 0 : (if (eq (posn-window (event-end click)) (selected-window))
969 0 : (posn-point (event-end click))
970 : ;; If the mouse ends up in any other window or on the menu
971 : ;; bar, use `window-point' of selected window (Bug#23707).
972 0 : (window-point)))
973 0 : (click-count (event-click-count click)))
974 0 : (let ((drag-start (terminal-parameter nil 'mouse-drag-start)))
975 0 : (when drag-start
976 : ;; Drag events don't come with a click count, sadly, so we hack
977 : ;; our way around this problem by remembering the start-event in
978 : ;; `mouse-drag-start' and fetching the click-count from there.
979 0 : (when (and (<= click-count 1)
980 0 : (equal beg (posn-point (event-start drag-start))))
981 0 : (setq click-count (event-click-count drag-start)))
982 : ;; Occasionally we get spurious drag events where the user hasn't
983 : ;; dragged his mouse, but instead Emacs has dragged the text under the
984 : ;; user's mouse. Try to recover those cases (bug#17562).
985 0 : (when (and (equal (posn-x-y (event-start click))
986 0 : (posn-x-y (event-end click)))
987 0 : (not (eq (car drag-start) 'mouse-movement)))
988 0 : (setq end beg))
989 0 : (setf (terminal-parameter nil 'mouse-drag-start) nil)))
990 0 : (when (and (integerp beg) (integerp end))
991 0 : (let ((range (mouse-start-end beg end (1- click-count))))
992 0 : (if (< end beg)
993 0 : (setq end (nth 0 range) beg (nth 1 range))
994 0 : (setq beg (nth 0 range) end (nth 1 range)))))
995 0 : (and mouse-drag-copy-region (integerp beg) (integerp end)
996 : ;; Don't set this-command to `kill-region', so a following
997 : ;; C-w won't double the text in the kill ring. Ignore
998 : ;; `last-command' so we don't append to a preceding kill.
999 0 : (let (this-command last-command deactivate-mark)
1000 0 : (copy-region-as-kill beg end)))
1001 0 : (if (numberp beg) (goto-char beg))
1002 : ;; On a text terminal, bounce the cursor.
1003 0 : (or transient-mark-mode
1004 0 : (window-system)
1005 0 : (sit-for 1))
1006 0 : (push-mark)
1007 0 : (set-mark (point))
1008 0 : (if (numberp end) (goto-char end))
1009 0 : (mouse-set-region-1)))
1010 :
1011 : (defun mouse-set-region-1 ()
1012 : ;; Set transient-mark-mode for a little while.
1013 0 : (unless (eq (car-safe transient-mark-mode) 'only)
1014 0 : (setq-local transient-mark-mode
1015 0 : (cons 'only
1016 0 : (unless (eq transient-mark-mode 'lambda)
1017 0 : transient-mark-mode))))
1018 0 : (setq mouse-last-region-beg (region-beginning))
1019 0 : (setq mouse-last-region-end (region-end))
1020 0 : (setq mouse-last-region-tick (buffer-modified-tick)))
1021 :
1022 : (defcustom mouse-scroll-delay 0.25
1023 : "The pause between scroll steps caused by mouse drags, in seconds.
1024 : If you drag the mouse beyond the edge of a window, Emacs scrolls the
1025 : window to bring the text beyond that edge into view, with a delay of
1026 : this many seconds between scroll steps. Scrolling stops when you move
1027 : the mouse back into the window, or release the button.
1028 : This variable's value may be non-integral.
1029 : Setting this to zero causes Emacs to scroll as fast as it can."
1030 : :type 'number
1031 : :group 'mouse)
1032 :
1033 : (defcustom mouse-scroll-min-lines 1
1034 : "The minimum number of lines scrolled by dragging mouse out of window.
1035 : Moving the mouse out the top or bottom edge of the window begins
1036 : scrolling repeatedly. The number of lines scrolled per repetition
1037 : is normally equal to the number of lines beyond the window edge that
1038 : the mouse has moved. However, it always scrolls at least the number
1039 : of lines specified by this variable."
1040 : :type 'integer
1041 : :group 'mouse)
1042 :
1043 : (defun mouse-scroll-subr (window jump &optional overlay start)
1044 : "Scroll the window WINDOW, JUMP lines at a time, until new input arrives.
1045 : If OVERLAY is an overlay, let it stretch from START to the far edge of
1046 : the newly visible text.
1047 : Upon exit, point is at the far edge of the newly visible text."
1048 0 : (cond
1049 0 : ((and (> jump 0) (< jump mouse-scroll-min-lines))
1050 0 : (setq jump mouse-scroll-min-lines))
1051 0 : ((and (< jump 0) (< (- jump) mouse-scroll-min-lines))
1052 0 : (setq jump (- mouse-scroll-min-lines))))
1053 0 : (let ((opoint (point)))
1054 0 : (while (progn
1055 0 : (goto-char (window-start window))
1056 0 : (if (not (zerop (vertical-motion jump window)))
1057 0 : (progn
1058 0 : (set-window-start window (point))
1059 0 : (if (natnump jump)
1060 0 : (if (window-end window)
1061 0 : (progn
1062 0 : (goto-char (window-end window))
1063 : ;; window-end doesn't reflect the window's new
1064 : ;; start position until the next redisplay.
1065 0 : (vertical-motion (1- jump) window))
1066 0 : (vertical-motion (- (window-height window) 2)))
1067 0 : (goto-char (window-start window)))
1068 0 : (if overlay
1069 0 : (move-overlay overlay start (point)))
1070 : ;; Now that we have scrolled WINDOW properly,
1071 : ;; put point back where it was for the redisplay
1072 : ;; so that we don't mess up the selected window.
1073 0 : (or (eq window (selected-window))
1074 0 : (goto-char opoint))
1075 0 : (sit-for mouse-scroll-delay)))))
1076 0 : (or (eq window (selected-window))
1077 0 : (goto-char opoint))))
1078 :
1079 : (defvar mouse-selection-click-count 0)
1080 :
1081 : (defvar mouse-selection-click-count-buffer nil)
1082 :
1083 : (defun mouse-drag-region (start-event)
1084 : "Set the region to the text that the mouse is dragged over.
1085 : Highlight the drag area as you move the mouse.
1086 : This must be bound to a button-down mouse event.
1087 : In Transient Mark mode, the highlighting remains as long as the mark
1088 : remains active. Otherwise, it remains until the next input event.
1089 :
1090 : When the region already exists and `mouse-drag-and-drop-region'
1091 : is non-nil, this moves the entire region of text to where mouse
1092 : is dragged over to."
1093 : (interactive "e")
1094 0 : (if (and mouse-drag-and-drop-region
1095 0 : (not (member 'triple (event-modifiers start-event)))
1096 0 : (equal (mouse-posn-property (event-start start-event) 'face) 'region))
1097 0 : (mouse-drag-and-drop-region start-event)
1098 : ;; Give temporary modes such as isearch a chance to turn off.
1099 0 : (run-hooks 'mouse-leave-buffer-hook)
1100 0 : (mouse-drag-track start-event)))
1101 :
1102 : (defun mouse-posn-property (pos property)
1103 : "Look for a property at click position.
1104 : POS may be either a buffer position or a click position like
1105 : those returned from `event-start'. If the click position is on
1106 : a string, the text property PROPERTY is examined.
1107 : If this is nil or the click is not on a string, then
1108 : the corresponding buffer position is searched for PROPERTY.
1109 : If PROPERTY is encountered in one of those places,
1110 : its value is returned."
1111 0 : (if (consp pos)
1112 0 : (let ((w (posn-window pos)) (pt (posn-point pos))
1113 0 : (str (posn-string pos)))
1114 0 : (or (and str
1115 0 : (get-text-property (cdr str) property (car str)))
1116 : ;; Mouse clicks in the fringe come with a position in
1117 : ;; (nth 5). This is useful but is not exactly where we clicked, so
1118 : ;; don't look up that position's properties!
1119 0 : (and pt (not (memq (posn-area pos) '(left-fringe right-fringe
1120 0 : left-margin right-margin)))
1121 0 : (get-char-property pt property w))))
1122 0 : (get-char-property pos property)))
1123 :
1124 : (defun mouse-on-link-p (pos)
1125 : "Return non-nil if POS is on a link in the current buffer.
1126 : POS must specify a buffer position in the current buffer, as a list
1127 : of the form returned by the `event-start' and `event-end' functions,
1128 : or a mouse event location in the selected window (see `event-start').
1129 : However, if `mouse-1-click-in-non-selected-windows' is non-nil,
1130 : POS may be a mouse event location in any window.
1131 :
1132 : A clickable link is identified by one of the following methods:
1133 :
1134 : - If the character at POS has a non-nil `follow-link' text or
1135 : overlay property, the value of that property determines what to do.
1136 :
1137 : - If there is a local key-binding or a keybinding at position POS
1138 : for the `follow-link' event, the binding of that event determines
1139 : what to do.
1140 :
1141 : The resulting value determine whether POS is inside a link:
1142 :
1143 : - If the value is `mouse-face', POS is inside a link if there
1144 : is a non-nil `mouse-face' property at POS. Return t in this case.
1145 :
1146 : - If the value is a function, FUNC, POS is inside a link if
1147 : the call \(FUNC POS) returns non-nil. Return the return value
1148 : from that call. Arg is \(posn-point POS) if POS is a mouse event.
1149 :
1150 : - Otherwise, return the value itself.
1151 :
1152 : The return value is interpreted as follows:
1153 :
1154 : - If it is a string, the mouse-1 event is translated into the
1155 : first character of the string, i.e. the action of the mouse-1
1156 : click is the local or global binding of that character.
1157 :
1158 : - If it is a vector, the mouse-1 event is translated into the
1159 : first element of that vector, i.e. the action of the mouse-1
1160 : click is the local or global binding of that event.
1161 :
1162 : - Otherwise, the mouse-1 event is translated into a mouse-2 event
1163 : at the same position."
1164 0 : (let ((action
1165 0 : (and (or (not (consp pos))
1166 0 : mouse-1-click-in-non-selected-windows
1167 0 : (eq (selected-window) (posn-window pos)))
1168 0 : (or (mouse-posn-property pos 'follow-link)
1169 0 : (let ((area (posn-area pos)))
1170 0 : (when area
1171 0 : (key-binding (vector area 'follow-link) nil t pos)))
1172 0 : (key-binding [follow-link] nil t pos)))))
1173 0 : (cond
1174 0 : ((eq action 'mouse-face)
1175 0 : (and (mouse-posn-property pos 'mouse-face) t))
1176 0 : ((functionp action)
1177 : ;; FIXME: This seems questionable if the click is not in a buffer.
1178 : ;; Should we instead decide that `action' takes a `posn'?
1179 0 : (if (consp pos)
1180 0 : (with-current-buffer (window-buffer (posn-window pos))
1181 0 : (funcall action (posn-point pos)))
1182 0 : (funcall action pos)))
1183 0 : (t action))))
1184 :
1185 : (defun mouse-fixup-help-message (msg)
1186 : "Fix help message MSG for `mouse-1-click-follows-link'."
1187 0 : (let (mp pos)
1188 0 : (if (and mouse-1-click-follows-link
1189 0 : (stringp msg)
1190 0 : (string-match-p "\\`mouse-2" msg)
1191 0 : (setq mp (mouse-pixel-position))
1192 0 : (consp (setq pos (cdr mp)))
1193 0 : (car pos) (>= (car pos) 0)
1194 0 : (cdr pos) (>= (cdr pos) 0)
1195 0 : (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
1196 0 : (windowp (posn-window pos)))
1197 0 : (with-current-buffer (window-buffer (posn-window pos))
1198 0 : (if (mouse-on-link-p pos)
1199 0 : (setq msg (concat
1200 0 : (cond
1201 0 : ((eq mouse-1-click-follows-link 'double) "double-")
1202 0 : ((and (integerp mouse-1-click-follows-link)
1203 0 : (< mouse-1-click-follows-link 0)) "Long ")
1204 0 : (t ""))
1205 0 : "mouse-1" (substring msg 7)))))))
1206 0 : msg)
1207 :
1208 : (defun mouse-drag-track (start-event)
1209 : "Track mouse drags by highlighting area between point and cursor.
1210 : The region will be defined with mark and point."
1211 0 : (mouse-minibuffer-check start-event)
1212 0 : (setq mouse-selection-click-count-buffer (current-buffer))
1213 0 : (deactivate-mark)
1214 0 : (let* ((scroll-margin 0) ; Avoid margin scrolling (Bug#9541).
1215 0 : (start-posn (event-start start-event))
1216 0 : (start-point (posn-point start-posn))
1217 0 : (start-window (posn-window start-posn))
1218 0 : (_ (with-current-buffer (window-buffer start-window)
1219 0 : (setq deactivate-mark nil)))
1220 : ;; We've recorded what we needed from the current buffer and
1221 : ;; window, now let's jump to the place of the event, where things
1222 : ;; are happening.
1223 0 : (_ (mouse-set-point start-event))
1224 : (echo-keystrokes 0)
1225 0 : (bounds (window-edges start-window))
1226 : (make-cursor-line-fully-visible nil)
1227 0 : (top (nth 1 bounds))
1228 0 : (bottom (if (window-minibuffer-p start-window)
1229 0 : (nth 3 bounds)
1230 : ;; Don't count the mode line.
1231 0 : (1- (nth 3 bounds))))
1232 0 : (click-count (1- (event-click-count start-event)))
1233 : ;; Suppress automatic hscrolling, because that is a nuisance
1234 : ;; when setting point near the right fringe (but see below).
1235 0 : (auto-hscroll-mode-saved auto-hscroll-mode)
1236 0 : (old-track-mouse track-mouse))
1237 :
1238 0 : (setq mouse-selection-click-count click-count)
1239 : ;; In case the down click is in the middle of some intangible text,
1240 : ;; use the end of that text, and put it in START-POINT.
1241 0 : (if (< (point) start-point)
1242 0 : (goto-char start-point))
1243 0 : (setq start-point (point))
1244 :
1245 : ;; Activate the region, using `mouse-start-end' to determine where
1246 : ;; to put point and mark (e.g., double-click will select a word).
1247 0 : (setq-local transient-mark-mode
1248 0 : (if (eq transient-mark-mode 'lambda)
1249 : '(only)
1250 0 : (cons 'only transient-mark-mode)))
1251 0 : (let ((range (mouse-start-end start-point start-point click-count)))
1252 0 : (push-mark (nth 0 range) t t)
1253 0 : (goto-char (nth 1 range)))
1254 :
1255 0 : (setf (terminal-parameter nil 'mouse-drag-start) start-event)
1256 0 : (setq track-mouse t)
1257 0 : (setq auto-hscroll-mode nil)
1258 :
1259 0 : (set-transient-map
1260 0 : (let ((map (make-sparse-keymap)))
1261 0 : (define-key map [switch-frame] #'ignore)
1262 0 : (define-key map [select-window] #'ignore)
1263 0 : (define-key map [mouse-movement]
1264 : (lambda (event) (interactive "e")
1265 0 : (let* ((end (event-end event))
1266 0 : (end-point (posn-point end)))
1267 0 : (unless (eq end-point start-point)
1268 : ;; As soon as the user moves, we can re-enable auto-hscroll.
1269 0 : (setq auto-hscroll-mode auto-hscroll-mode-saved)
1270 : ;; And remember that we have moved, so mouse-set-region can know
1271 : ;; its event is really a drag event.
1272 0 : (setcar start-event 'mouse-movement))
1273 0 : (if (and (eq (posn-window end) start-window)
1274 0 : (integer-or-marker-p end-point))
1275 0 : (mouse--drag-set-mark-and-point start-point
1276 0 : end-point click-count)
1277 0 : (let ((mouse-row (cdr (cdr (mouse-position)))))
1278 0 : (cond
1279 0 : ((null mouse-row))
1280 0 : ((< mouse-row top)
1281 0 : (mouse-scroll-subr start-window (- mouse-row top)
1282 0 : nil start-point))
1283 0 : ((>= mouse-row bottom)
1284 0 : (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
1285 0 : nil start-point))))))))
1286 0 : map)
1287 : t (lambda ()
1288 0 : (setq track-mouse old-track-mouse)
1289 0 : (setq auto-hscroll-mode auto-hscroll-mode-saved)
1290 0 : (deactivate-mark)
1291 0 : (pop-mark)))))
1292 :
1293 : (defun mouse--drag-set-mark-and-point (start click click-count)
1294 0 : (let* ((range (mouse-start-end start click click-count))
1295 0 : (beg (nth 0 range))
1296 0 : (end (nth 1 range)))
1297 0 : (cond ((eq (mark) beg)
1298 0 : (goto-char end))
1299 0 : ((eq (mark) end)
1300 0 : (goto-char beg))
1301 0 : ((< click (mark))
1302 0 : (set-mark end)
1303 0 : (goto-char beg))
1304 : (t
1305 0 : (set-mark beg)
1306 0 : (goto-char end)))))
1307 :
1308 : ;; Commands to handle xterm-style multiple clicks.
1309 : (defun mouse-skip-word (dir)
1310 : "Skip over word, over whitespace, or over identical punctuation.
1311 : If DIR is positive skip forward; if negative, skip backward."
1312 0 : (let* ((char (following-char))
1313 0 : (syntax (char-to-string (char-syntax char))))
1314 0 : (cond ((string= syntax "w")
1315 : ;; Here, we can't use skip-syntax-forward/backward because
1316 : ;; they don't pay attention to word-separating-categories,
1317 : ;; and thus they will skip over a true word boundary. So,
1318 : ;; we simulate the original behavior by using forward-word.
1319 0 : (if (< dir 0)
1320 0 : (if (not (looking-at "\\<"))
1321 0 : (forward-word -1))
1322 0 : (if (or (looking-at "\\<") (not (looking-at "\\>")))
1323 0 : (forward-word 1))))
1324 0 : ((string= syntax " ")
1325 0 : (if (< dir 0)
1326 0 : (skip-syntax-backward syntax)
1327 0 : (skip-syntax-forward syntax)))
1328 0 : ((string= syntax "_")
1329 0 : (if (< dir 0)
1330 0 : (skip-syntax-backward "w_")
1331 0 : (skip-syntax-forward "w_")))
1332 0 : ((< dir 0)
1333 0 : (while (and (not (bobp)) (= (preceding-char) char))
1334 0 : (forward-char -1)))
1335 : (t
1336 0 : (while (and (not (eobp)) (= (following-char) char))
1337 0 : (forward-char 1))))))
1338 :
1339 : (defun mouse-start-end (start end mode)
1340 : "Return a list of region bounds based on START and END according to MODE.
1341 : If MODE is 0 then set point to (min START END), mark to (max START END).
1342 : If MODE is 1 then set point to start of word at (min START END),
1343 : mark to end of word at (max START END).
1344 : If MODE is 2 then do the same for lines."
1345 0 : (if (> start end)
1346 0 : (let ((temp start))
1347 0 : (setq start end
1348 0 : end temp)))
1349 0 : (setq mode (mod mode 3))
1350 0 : (cond ((= mode 0)
1351 0 : (list start end))
1352 0 : ((and (= mode 1)
1353 0 : (= start end)
1354 0 : (char-after start)
1355 0 : (= (char-syntax (char-after start)) ?\())
1356 0 : (if (/= (syntax-class (syntax-after start)) 4) ; raw syntax code for ?\(
1357 : ;; This happens in CC Mode when unbalanced parens in CPP
1358 : ;; constructs are given punctuation syntax with
1359 : ;; syntax-table text properties. (2016-02-21).
1360 0 : (signal 'scan-error (list "Containing expression ends prematurely"
1361 0 : start start))
1362 0 : (list start
1363 0 : (save-excursion
1364 0 : (goto-char start)
1365 0 : (forward-sexp 1)
1366 0 : (point)))))
1367 0 : ((and (= mode 1)
1368 0 : (= start end)
1369 0 : (char-after start)
1370 0 : (= (char-syntax (char-after start)) ?\)))
1371 0 : (if (/= (syntax-class (syntax-after start)) 5) ; raw syntax code for ?\)
1372 : ;; See above comment about CC Mode.
1373 0 : (signal 'scan-error (list "Unbalanced parentheses" start start))
1374 0 : (list (save-excursion
1375 0 : (goto-char (1+ start))
1376 0 : (backward-sexp 1)
1377 0 : (point))
1378 0 : (1+ start))))
1379 0 : ((and (= mode 1)
1380 0 : (= start end)
1381 0 : (char-after start)
1382 0 : (= (char-syntax (char-after start)) ?\"))
1383 0 : (let ((open (or (eq start (point-min))
1384 0 : (save-excursion
1385 0 : (goto-char (- start 1))
1386 0 : (looking-at "\\s(\\|\\s \\|\\s>")))))
1387 0 : (if open
1388 0 : (list start
1389 0 : (save-excursion
1390 0 : (condition-case nil
1391 0 : (progn
1392 0 : (goto-char start)
1393 0 : (forward-sexp 1)
1394 0 : (point))
1395 0 : (error end))))
1396 0 : (list (save-excursion
1397 0 : (condition-case nil
1398 0 : (progn
1399 0 : (goto-char (1+ start))
1400 0 : (backward-sexp 1)
1401 0 : (point))
1402 0 : (error end)))
1403 0 : (1+ start)))))
1404 0 : ((= mode 1)
1405 0 : (list (save-excursion
1406 0 : (goto-char start)
1407 0 : (mouse-skip-word -1)
1408 0 : (point))
1409 0 : (save-excursion
1410 0 : (goto-char end)
1411 0 : (mouse-skip-word 1)
1412 0 : (point))))
1413 0 : ((= mode 2)
1414 0 : (list (save-excursion
1415 0 : (goto-char start)
1416 0 : (line-beginning-position 1))
1417 0 : (save-excursion
1418 0 : (goto-char end)
1419 0 : (forward-line 1)
1420 0 : (point))))))
1421 :
1422 : ;; Subroutine: set the mark where CLICK happened,
1423 : ;; but don't do anything else.
1424 : (defun mouse-set-mark-fast (click)
1425 0 : (mouse-minibuffer-check click)
1426 0 : (let ((posn (event-start click)))
1427 0 : (select-window (posn-window posn))
1428 0 : (if (numberp (posn-point posn))
1429 0 : (push-mark (posn-point posn) t t))))
1430 :
1431 : (defun mouse-undouble-last-event (events)
1432 0 : (let* ((index (1- (length events)))
1433 0 : (last (nthcdr index events))
1434 0 : (event (car last))
1435 0 : (basic (event-basic-type event))
1436 0 : (old-modifiers (event-modifiers event))
1437 0 : (modifiers (delq 'double (delq 'triple (copy-sequence old-modifiers))))
1438 : (new
1439 0 : (if (consp event)
1440 : ;; Use reverse, not nreverse, since event-modifiers
1441 : ;; does not copy the list it returns.
1442 0 : (cons (event-convert-list (reverse (cons basic modifiers)))
1443 0 : (cdr event))
1444 0 : event)))
1445 0 : (setcar last new)
1446 0 : (if (and (not (equal modifiers old-modifiers))
1447 0 : (key-binding (apply 'vector events)))
1448 : t
1449 0 : (setcar last event)
1450 0 : nil)))
1451 :
1452 : ;; Momentarily show where the mark is, if highlighting doesn't show it.
1453 :
1454 : (defun mouse-set-mark (click)
1455 : "Set mark at the position clicked on with the mouse.
1456 : Display cursor at that position for a second.
1457 : This must be bound to a mouse click."
1458 : (interactive "e")
1459 0 : (mouse-minibuffer-check click)
1460 0 : (select-window (posn-window (event-start click)))
1461 : ;; FIXME: Use save-excursion
1462 0 : (let ((point-save (point)))
1463 0 : (unwind-protect
1464 0 : (progn (mouse-set-point click)
1465 0 : (push-mark nil t t)
1466 0 : (or transient-mark-mode
1467 0 : (sit-for 1)))
1468 0 : (goto-char point-save))))
1469 :
1470 : (defun mouse-kill (click)
1471 : "Kill the region between point and the mouse click.
1472 : The text is saved in the kill ring, as with \\[kill-region]."
1473 : (interactive "e")
1474 0 : (mouse-minibuffer-check click)
1475 0 : (let* ((posn (event-start click))
1476 0 : (click-posn (posn-point posn)))
1477 0 : (select-window (posn-window posn))
1478 0 : (if (numberp click-posn)
1479 0 : (kill-region (min (point) click-posn)
1480 0 : (max (point) click-posn)))))
1481 :
1482 : (defun mouse-yank-at-click (click arg)
1483 : "Insert the last stretch of killed text at the position clicked on.
1484 : Also move point to one end of the text thus inserted (normally the end),
1485 : and set mark at the beginning.
1486 : Prefix arguments are interpreted as with \\[yank].
1487 : If `mouse-yank-at-point' is non-nil, insert at point
1488 : regardless of where you click."
1489 : (interactive "e\nP")
1490 : ;; Give temporary modes such as isearch a chance to turn off.
1491 0 : (run-hooks 'mouse-leave-buffer-hook)
1492 0 : (when select-active-regions
1493 : ;; Without this, confusing things happen upon e.g. inserting into
1494 : ;; the middle of an active region.
1495 0 : (deactivate-mark))
1496 0 : (or mouse-yank-at-point (mouse-set-point click))
1497 0 : (setq this-command 'yank)
1498 0 : (setq mouse-selection-click-count 0)
1499 0 : (yank arg))
1500 :
1501 : (defun mouse-yank-primary (click)
1502 : "Insert the primary selection at the position clicked on.
1503 : Move point to the end of the inserted text, and set mark at
1504 : beginning. If `mouse-yank-at-point' is non-nil, insert at point
1505 : regardless of where you click."
1506 : (interactive "e")
1507 : ;; Give temporary modes such as isearch a chance to turn off.
1508 0 : (run-hooks 'mouse-leave-buffer-hook)
1509 : ;; Without this, confusing things happen upon e.g. inserting into
1510 : ;; the middle of an active region.
1511 0 : (when select-active-regions
1512 0 : (let (select-active-regions)
1513 0 : (deactivate-mark)))
1514 0 : (or mouse-yank-at-point (mouse-set-point click))
1515 0 : (let ((primary (gui-get-primary-selection)))
1516 0 : (push-mark)
1517 0 : (insert-for-yank primary)))
1518 :
1519 : (defun mouse-kill-ring-save (click)
1520 : "Copy the region between point and the mouse click in the kill ring.
1521 : This does not delete the region; it acts like \\[kill-ring-save]."
1522 : (interactive "e")
1523 0 : (mouse-set-mark-fast click)
1524 0 : (let (this-command last-command)
1525 0 : (kill-ring-save (point) (mark t))))
1526 :
1527 : ;; This function used to delete the text between point and the mouse
1528 : ;; whenever it was equal to the front of the kill ring, but some
1529 : ;; people found that confusing.
1530 :
1531 : ;; The position of the last invocation of `mouse-save-then-kill'.
1532 : (defvar mouse-save-then-kill-posn nil)
1533 :
1534 : (defun mouse-save-then-kill-delete-region (beg end)
1535 : ;; We must make our own undo boundaries
1536 : ;; because they happen automatically only for the current buffer.
1537 0 : (undo-boundary)
1538 0 : (if (or (= beg end) (eq buffer-undo-list t))
1539 : ;; If we have no undo list in this buffer,
1540 : ;; just delete.
1541 0 : (delete-region beg end)
1542 : ;; Delete, but make the undo-list entry share with the kill ring.
1543 : ;; First, delete just one char, so in case buffer is being modified
1544 : ;; for the first time, the undo list records that fact.
1545 0 : (let ((inhibit-modification-hooks t))
1546 0 : (delete-region beg
1547 0 : (+ beg (if (> end beg) 1 -1))))
1548 0 : (let ((buffer-undo-list buffer-undo-list))
1549 : ;; Undo that deletion--but don't change the undo list!
1550 0 : (let ((inhibit-modification-hooks t))
1551 0 : (primitive-undo 1 buffer-undo-list))
1552 : ;; Now delete the rest of the specified region,
1553 : ;; but don't record it.
1554 0 : (setq buffer-undo-list t)
1555 0 : (if (/= (length (car kill-ring)) (- (max end beg) (min end beg)))
1556 0 : (error "Lossage in mouse-save-then-kill-delete-region"))
1557 0 : (delete-region beg end))
1558 0 : (let ((tail buffer-undo-list))
1559 : ;; Search back in buffer-undo-list for the string
1560 : ;; that came from deleting one character.
1561 0 : (while (and tail (not (stringp (car (car tail)))))
1562 0 : (setq tail (cdr tail)))
1563 : ;; Replace it with an entry for the entire deleted text.
1564 0 : (and tail
1565 0 : (setcar tail (cons (car kill-ring) (min beg end))))))
1566 0 : (undo-boundary))
1567 :
1568 : (defun mouse-save-then-kill (click)
1569 : "Set the region according to CLICK; the second time, kill it.
1570 : CLICK should be a mouse click event.
1571 :
1572 : If the region is inactive, activate it temporarily. Set mark at
1573 : the original point, and move point to the position of CLICK.
1574 :
1575 : If the region is already active, adjust it. Normally, do this by
1576 : moving point or mark, whichever is closer, to CLICK. But if you
1577 : have selected whole words or lines, move point or mark to the
1578 : word or line boundary closest to CLICK instead.
1579 :
1580 : If `mouse-drag-copy-region' is non-nil, this command also saves the
1581 : new region to the kill ring (replacing the previous kill if the
1582 : previous region was just saved to the kill ring).
1583 :
1584 : If this command is called a second consecutive time with the same
1585 : CLICK position, kill the region (or delete it
1586 : if `mouse-drag-copy-region' is non-nil)"
1587 : (interactive "e")
1588 0 : (mouse-minibuffer-check click)
1589 0 : (let* ((posn (event-start click))
1590 0 : (click-pt (posn-point posn))
1591 0 : (window (posn-window posn))
1592 0 : (buf (window-buffer window))
1593 : ;; Don't let a subsequent kill command append to this one.
1594 0 : (this-command this-command)
1595 : ;; Check if the user has multi-clicked to select words/lines.
1596 : (click-count
1597 0 : (if (and (eq mouse-selection-click-count-buffer buf)
1598 0 : (with-current-buffer buf (mark t)))
1599 0 : mouse-selection-click-count
1600 0 : 0)))
1601 0 : (cond
1602 0 : ((not (numberp click-pt)) nil)
1603 : ;; If the user clicked without moving point, kill the region.
1604 : ;; This also resets `mouse-selection-click-count'.
1605 0 : ((and (eq last-command 'mouse-save-then-kill)
1606 0 : (eq click-pt mouse-save-then-kill-posn)
1607 0 : (eq window (selected-window)))
1608 0 : (if mouse-drag-copy-region
1609 : ;; Region already saved in the previous click;
1610 : ;; don't make a duplicate entry, just delete.
1611 0 : (delete-region (mark t) (point))
1612 0 : (kill-region (mark t) (point)))
1613 0 : (setq mouse-selection-click-count 0)
1614 0 : (setq mouse-save-then-kill-posn nil))
1615 :
1616 : ;; Otherwise, if there is a suitable region, adjust it by moving
1617 : ;; one end (whichever is closer) to CLICK-PT.
1618 0 : ((or (with-current-buffer buf (region-active-p))
1619 0 : (and (eq window (selected-window))
1620 0 : (mark t)
1621 0 : (or (and (eq last-command 'mouse-save-then-kill)
1622 0 : mouse-save-then-kill-posn)
1623 0 : (and (memq last-command '(mouse-drag-region
1624 0 : mouse-set-region))
1625 0 : (or mark-even-if-inactive
1626 0 : (not transient-mark-mode))))))
1627 0 : (select-window window)
1628 0 : (let* ((range (mouse-start-end click-pt click-pt click-count)))
1629 0 : (if (< (abs (- click-pt (mark t)))
1630 0 : (abs (- click-pt (point))))
1631 0 : (set-mark (car range))
1632 0 : (goto-char (nth 1 range)))
1633 0 : (setq deactivate-mark nil)
1634 0 : (mouse-set-region-1)
1635 0 : (when mouse-drag-copy-region
1636 : ;; Region already copied to kill-ring once, so replace.
1637 0 : (kill-new (filter-buffer-substring (mark t) (point)) t))
1638 : ;; Arrange for a repeated mouse-3 to kill the region.
1639 0 : (setq mouse-save-then-kill-posn click-pt)))
1640 :
1641 : ;; Otherwise, set the mark where point is and move to CLICK-PT.
1642 : (t
1643 0 : (select-window window)
1644 0 : (mouse-set-mark-fast click)
1645 0 : (let ((before-scroll (with-current-buffer buf point-before-scroll)))
1646 0 : (if before-scroll (goto-char before-scroll)))
1647 0 : (exchange-point-and-mark)
1648 0 : (mouse-set-region-1)
1649 0 : (when mouse-drag-copy-region
1650 0 : (kill-new (filter-buffer-substring (mark t) (point))))
1651 0 : (setq mouse-save-then-kill-posn click-pt)))))
1652 :
1653 :
1654 : (global-set-key [M-mouse-1] 'mouse-start-secondary)
1655 : (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
1656 : (global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
1657 : (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
1658 : (global-set-key [M-mouse-2] 'mouse-yank-secondary)
1659 :
1660 : (defconst mouse-secondary-overlay
1661 : (let ((ol (make-overlay (point-min) (point-min))))
1662 : (delete-overlay ol)
1663 : (overlay-put ol 'face 'secondary-selection)
1664 : ol)
1665 : "An overlay which records the current secondary selection.
1666 : It is deleted when there is no secondary selection.")
1667 :
1668 : (defvar mouse-secondary-click-count 0)
1669 :
1670 : ;; A marker which records the specified first end for a secondary selection.
1671 : ;; May be nil.
1672 : (defvar mouse-secondary-start nil)
1673 :
1674 : (defun mouse-start-secondary (click)
1675 : "Set one end of the secondary selection to the position clicked on.
1676 : Use \\[mouse-secondary-save-then-kill] to set the other end
1677 : and complete the secondary selection."
1678 : (interactive "e")
1679 0 : (mouse-minibuffer-check click)
1680 0 : (let ((posn (event-start click)))
1681 0 : (with-current-buffer (window-buffer (posn-window posn))
1682 : ;; Cancel any preexisting secondary selection.
1683 0 : (delete-overlay mouse-secondary-overlay)
1684 0 : (if (numberp (posn-point posn))
1685 0 : (progn
1686 0 : (or mouse-secondary-start
1687 0 : (setq mouse-secondary-start (make-marker)))
1688 0 : (move-marker mouse-secondary-start (posn-point posn)))))))
1689 :
1690 : (defun mouse-set-secondary (click)
1691 : "Set the secondary selection to the text that the mouse is dragged over.
1692 : This must be bound to a mouse drag event."
1693 : (interactive "e")
1694 0 : (mouse-minibuffer-check click)
1695 0 : (let ((posn (event-start click))
1696 : beg
1697 0 : (end (event-end click)))
1698 0 : (with-current-buffer (window-buffer (posn-window posn))
1699 0 : (if (numberp (posn-point posn))
1700 0 : (setq beg (posn-point posn)))
1701 0 : (move-overlay mouse-secondary-overlay beg (posn-point end))
1702 0 : (gui-set-selection
1703 : 'SECONDARY
1704 0 : (buffer-substring (overlay-start mouse-secondary-overlay)
1705 0 : (overlay-end mouse-secondary-overlay))))))
1706 :
1707 : (defun mouse-drag-secondary (start-event)
1708 : "Set the secondary selection to the text that the mouse is dragged over.
1709 : Highlight the drag area as you move the mouse.
1710 : This must be bound to a button-down mouse event.
1711 : The function returns a non-nil value if it creates a secondary selection."
1712 : (interactive "e")
1713 0 : (mouse-minibuffer-check start-event)
1714 0 : (let* ((echo-keystrokes 0)
1715 0 : (start-posn (event-start start-event))
1716 0 : (start-point (posn-point start-posn))
1717 0 : (start-window (posn-window start-posn))
1718 0 : (bounds (window-edges start-window))
1719 0 : (top (nth 1 bounds))
1720 0 : (bottom (if (window-minibuffer-p start-window)
1721 0 : (nth 3 bounds)
1722 : ;; Don't count the mode line.
1723 0 : (1- (nth 3 bounds))))
1724 0 : (click-count (1- (event-click-count start-event))))
1725 0 : (with-current-buffer (window-buffer start-window)
1726 0 : (setq mouse-secondary-click-count click-count)
1727 0 : (if (> (mod click-count 3) 0)
1728 : ;; Double or triple press: make an initial selection
1729 : ;; of one word or line.
1730 0 : (let ((range (mouse-start-end start-point start-point click-count)))
1731 0 : (set-marker mouse-secondary-start nil)
1732 0 : (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
1733 0 : (window-buffer start-window)))
1734 : ;; Single-press: cancel any preexisting secondary selection.
1735 0 : (or mouse-secondary-start
1736 0 : (setq mouse-secondary-start (make-marker)))
1737 0 : (set-marker mouse-secondary-start start-point)
1738 0 : (delete-overlay mouse-secondary-overlay))
1739 : ;; FIXME: Use mouse-drag-track!
1740 0 : (let (event end end-point)
1741 0 : (track-mouse
1742 0 : (while (progn
1743 0 : (setq event (read-event))
1744 0 : (or (mouse-movement-p event)
1745 0 : (memq (car-safe event) '(switch-frame select-window))))
1746 :
1747 0 : (if (memq (car-safe event) '(switch-frame select-window))
1748 : nil
1749 0 : (setq end (event-end event)
1750 0 : end-point (posn-point end))
1751 0 : (cond
1752 : ;; Are we moving within the original window?
1753 0 : ((and (eq (posn-window end) start-window)
1754 0 : (integer-or-marker-p end-point))
1755 0 : (let ((range (mouse-start-end start-point end-point
1756 0 : click-count)))
1757 0 : (if (or (/= start-point end-point)
1758 0 : (null (marker-position mouse-secondary-start)))
1759 0 : (progn
1760 0 : (set-marker mouse-secondary-start nil)
1761 0 : (move-overlay mouse-secondary-overlay
1762 0 : (car range) (nth 1 range))))))
1763 : (t
1764 0 : (let ((mouse-row (cdr (cdr (mouse-position)))))
1765 0 : (cond
1766 0 : ((null mouse-row))
1767 0 : ((< mouse-row top)
1768 0 : (mouse-scroll-subr start-window (- mouse-row top)
1769 0 : mouse-secondary-overlay start-point))
1770 0 : ((>= mouse-row bottom)
1771 0 : (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
1772 0 : mouse-secondary-overlay start-point)))))))))
1773 :
1774 0 : (if (consp event)
1775 0 : (if (marker-position mouse-secondary-start)
1776 0 : (save-window-excursion
1777 0 : (delete-overlay mouse-secondary-overlay)
1778 0 : (gui-set-selection 'SECONDARY nil)
1779 0 : (select-window start-window)
1780 0 : (save-excursion
1781 0 : (goto-char mouse-secondary-start)
1782 0 : (sit-for 1)
1783 0 : nil))
1784 0 : (gui-set-selection
1785 : 'SECONDARY
1786 0 : (buffer-substring (overlay-start mouse-secondary-overlay)
1787 0 : (overlay-end mouse-secondary-overlay)))))))))
1788 :
1789 : (defun mouse-yank-secondary (click)
1790 : "Insert the secondary selection at the position clicked on.
1791 : Move point to the end of the inserted text.
1792 : If `mouse-yank-at-point' is non-nil, insert at point
1793 : regardless of where you click."
1794 : (interactive "e")
1795 : ;; Give temporary modes such as isearch a chance to turn off.
1796 0 : (run-hooks 'mouse-leave-buffer-hook)
1797 0 : (or mouse-yank-at-point (mouse-set-point click))
1798 0 : (let ((secondary (gui-get-selection 'SECONDARY)))
1799 0 : (if secondary
1800 0 : (insert-for-yank secondary)
1801 0 : (error "No secondary selection"))))
1802 :
1803 : (defun mouse-kill-secondary ()
1804 : "Kill the text in the secondary selection.
1805 : This is intended more as a keyboard command than as a mouse command
1806 : but it can work as either one.
1807 :
1808 : The current buffer (in case of keyboard use), or the buffer clicked on,
1809 : must be the one that the secondary selection is in. This requirement
1810 : is to prevent accidents."
1811 : (interactive)
1812 0 : (let* ((keys (this-command-keys))
1813 0 : (click (elt keys (1- (length keys)))))
1814 0 : (or (eq (overlay-buffer mouse-secondary-overlay)
1815 0 : (if (listp click)
1816 0 : (window-buffer (posn-window (event-start click)))
1817 0 : (current-buffer)))
1818 0 : (error "Select or click on the buffer where the secondary selection is")))
1819 0 : (let (this-command)
1820 0 : (with-current-buffer (overlay-buffer mouse-secondary-overlay)
1821 0 : (kill-region (overlay-start mouse-secondary-overlay)
1822 0 : (overlay-end mouse-secondary-overlay))))
1823 0 : (delete-overlay mouse-secondary-overlay))
1824 :
1825 : (defun mouse-secondary-save-then-kill (click)
1826 : "Set the secondary selection and save it to the kill ring.
1827 : The second time, kill it. CLICK should be a mouse click event.
1828 :
1829 : If you have not called `mouse-start-secondary' in the clicked
1830 : buffer, activate the secondary selection and set it between point
1831 : and the click position CLICK.
1832 :
1833 : Otherwise, adjust the bounds of the secondary selection.
1834 : Normally, do this by moving its beginning or end, whichever is
1835 : closer, to CLICK. But if you have selected whole words or lines,
1836 : adjust to the word or line boundary closest to CLICK instead.
1837 :
1838 : If this command is called a second consecutive time with the same
1839 : CLICK position, kill the secondary selection."
1840 : (interactive "e")
1841 0 : (mouse-minibuffer-check click)
1842 0 : (let* ((posn (event-start click))
1843 0 : (click-pt (posn-point posn))
1844 0 : (window (posn-window posn))
1845 0 : (buf (window-buffer window))
1846 : ;; Don't let a subsequent kill command append to this one.
1847 0 : (this-command this-command)
1848 : ;; Check if the user has multi-clicked to select words/lines.
1849 : (click-count
1850 0 : (if (eq (overlay-buffer mouse-secondary-overlay) buf)
1851 0 : mouse-secondary-click-count
1852 0 : 0))
1853 0 : (beg (overlay-start mouse-secondary-overlay))
1854 0 : (end (overlay-end mouse-secondary-overlay)))
1855 :
1856 0 : (cond
1857 0 : ((not (numberp click-pt)) nil)
1858 :
1859 : ;; If the secondary selection is not active in BUF, activate it.
1860 0 : ((not (eq buf (or (overlay-buffer mouse-secondary-overlay)
1861 0 : (if mouse-secondary-start
1862 0 : (marker-buffer mouse-secondary-start)))))
1863 0 : (select-window window)
1864 0 : (setq mouse-secondary-start (make-marker))
1865 0 : (move-marker mouse-secondary-start (point))
1866 0 : (move-overlay mouse-secondary-overlay (point) click-pt buf)
1867 0 : (kill-ring-save (point) click-pt))
1868 :
1869 : ;; If the user clicked without moving point, delete the secondary
1870 : ;; selection. This also resets `mouse-secondary-click-count'.
1871 0 : ((and (eq last-command 'mouse-secondary-save-then-kill)
1872 0 : (eq click-pt mouse-save-then-kill-posn)
1873 0 : (eq window (selected-window)))
1874 0 : (mouse-save-then-kill-delete-region beg end)
1875 0 : (delete-overlay mouse-secondary-overlay)
1876 0 : (setq mouse-secondary-click-count 0)
1877 0 : (setq mouse-save-then-kill-posn nil))
1878 :
1879 : ;; Otherwise, if there is a suitable secondary selection overlay,
1880 : ;; adjust it by moving one end (whichever is closer) to CLICK-PT.
1881 0 : ((and beg (eq buf (overlay-buffer mouse-secondary-overlay)))
1882 0 : (let* ((range (mouse-start-end click-pt click-pt click-count)))
1883 0 : (if (< (abs (- click-pt beg))
1884 0 : (abs (- click-pt end)))
1885 0 : (move-overlay mouse-secondary-overlay (car range) end)
1886 0 : (move-overlay mouse-secondary-overlay beg (nth 1 range))))
1887 0 : (setq deactivate-mark nil)
1888 0 : (if (eq last-command 'mouse-secondary-save-then-kill)
1889 : ;; If the front of the kill ring comes from an immediately
1890 : ;; previous use of this command, replace the entry.
1891 0 : (kill-new
1892 0 : (buffer-substring (overlay-start mouse-secondary-overlay)
1893 0 : (overlay-end mouse-secondary-overlay))
1894 0 : t)
1895 0 : (let (deactivate-mark)
1896 0 : (copy-region-as-kill (overlay-start mouse-secondary-overlay)
1897 0 : (overlay-end mouse-secondary-overlay))))
1898 0 : (setq mouse-save-then-kill-posn click-pt))
1899 :
1900 : ;; Otherwise, set the secondary selection overlay.
1901 : (t
1902 0 : (select-window window)
1903 0 : (if mouse-secondary-start
1904 : ;; All we have is one end of a selection, so put the other
1905 : ;; end here.
1906 0 : (let ((start (+ 0 mouse-secondary-start)))
1907 0 : (kill-ring-save start click-pt)
1908 0 : (move-overlay mouse-secondary-overlay start click-pt)))
1909 0 : (setq mouse-save-then-kill-posn click-pt))))
1910 :
1911 : ;; Finally, set the window system's secondary selection.
1912 0 : (let (str)
1913 0 : (and (overlay-buffer mouse-secondary-overlay)
1914 0 : (setq str (buffer-substring (overlay-start mouse-secondary-overlay)
1915 0 : (overlay-end mouse-secondary-overlay)))
1916 0 : (> (length str) 0)
1917 0 : (gui-set-selection 'SECONDARY str))))
1918 :
1919 :
1920 : (defcustom mouse-buffer-menu-maxlen 20
1921 : "Number of buffers in one pane (submenu) of the buffer menu.
1922 : If we have lots of buffers, divide them into groups of
1923 : `mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one."
1924 : :type 'integer
1925 : :group 'mouse)
1926 :
1927 : (defcustom mouse-buffer-menu-mode-mult 4
1928 : "Group the buffers by the major mode groups on \\[mouse-buffer-menu]?
1929 : This number which determines (in a hairy way) whether \\[mouse-buffer-menu]
1930 : will split the buffer menu by the major modes (see
1931 : `mouse-buffer-menu-mode-groups') or just by menu length.
1932 : Set to 1 (or even 0!) if you want to group by major mode always, and to
1933 : a large number if you prefer a mixed multitude. The default is 4."
1934 : :type 'integer
1935 : :group 'mouse
1936 : :version "20.3")
1937 :
1938 : (defvar mouse-buffer-menu-mode-groups
1939 : (mapcar (lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg))))
1940 : '(("Info\\|Help\\|Apropos\\|Man" . "Help")
1941 : ("\\bVM\\b\\|\\bMH\\b\\|Message\\|Mail\\|Group\\|Score\\|Summary\\|Article"
1942 : . "Mail/News")
1943 : ("\\<C\\>" . "C")
1944 : ("ObjC" . "C")
1945 : ("Text" . "Text")
1946 : ("Outline" . "Text")
1947 : ("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML")
1948 : ("log\\|diff\\|vc\\|cvs\\|Annotate" . "Version Control") ; "Change Management"?
1949 : ("Threads\\|Memory\\|Disassembly\\|Breakpoints\\|Frames\\|Locals\\|Registers\\|Inferior I/O\\|Debugger"
1950 : . "GDB")
1951 : ("Lisp" . "Lisp")))
1952 : "How to group various major modes together in \\[mouse-buffer-menu].
1953 : Each element has the form (REGEXP . GROUPNAME).
1954 : If the major mode's name string matches REGEXP, use GROUPNAME instead.")
1955 :
1956 : (defun mouse-buffer-menu (event)
1957 : "Pop up a menu of buffers for selection with the mouse.
1958 : This switches buffers in the window that you clicked on,
1959 : and selects that window."
1960 : (interactive "e")
1961 0 : (mouse-minibuffer-check event)
1962 0 : (let ((buf (x-popup-menu event (mouse-buffer-menu-map)))
1963 0 : (window (posn-window (event-start event))))
1964 0 : (when buf
1965 0 : (select-window
1966 0 : (if (framep window) (frame-selected-window window)
1967 0 : window))
1968 0 : (switch-to-buffer buf))))
1969 :
1970 : (defun mouse-buffer-menu-map ()
1971 : ;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
1972 0 : (let ((buffers (buffer-list)) split-by-major-mode sum-of-squares)
1973 0 : (dolist (buf buffers)
1974 : ;; Divide all buffers into buckets for various major modes.
1975 : ;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
1976 0 : (with-current-buffer buf
1977 0 : (let* ((adjusted-major-mode major-mode) elt)
1978 0 : (dolist (group mouse-buffer-menu-mode-groups)
1979 0 : (when (string-match (car group) (format-mode-line mode-name))
1980 0 : (setq adjusted-major-mode (cdr group))))
1981 0 : (setq elt (assoc adjusted-major-mode split-by-major-mode))
1982 0 : (unless elt
1983 0 : (setq elt (list adjusted-major-mode
1984 0 : (if (stringp adjusted-major-mode)
1985 0 : adjusted-major-mode
1986 0 : (format-mode-line mode-name nil nil buf)))
1987 0 : split-by-major-mode (cons elt split-by-major-mode)))
1988 0 : (or (memq buf (cdr (cdr elt)))
1989 0 : (setcdr (cdr elt) (cons buf (cdr (cdr elt))))))))
1990 : ;; Compute the sum of squares of sizes of the major-mode buckets.
1991 0 : (let ((tail split-by-major-mode))
1992 0 : (setq sum-of-squares 0)
1993 0 : (while tail
1994 0 : (setq sum-of-squares
1995 0 : (+ sum-of-squares
1996 0 : (let ((len (length (cdr (cdr (car tail)))))) (* len len))))
1997 0 : (setq tail (cdr tail))))
1998 0 : (if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
1999 0 : (* (length buffers) (length buffers)))
2000 : ;; Subdividing by major modes really helps, so let's do it.
2001 0 : (let (subdivided-menus (buffers-left (length buffers)))
2002 : ;; Sort the list to put the most popular major modes first.
2003 0 : (setq split-by-major-mode
2004 0 : (sort split-by-major-mode
2005 0 : (function (lambda (elt1 elt2)
2006 0 : (> (length elt1) (length elt2))))))
2007 : ;; Make a separate submenu for each major mode
2008 : ;; that has more than one buffer,
2009 : ;; unless all the remaining buffers are less than 1/10 of them.
2010 0 : (while (and split-by-major-mode
2011 0 : (and (> (length (car split-by-major-mode)) 3)
2012 0 : (> (* buffers-left 10) (length buffers))))
2013 0 : (let ((this-mode-list (mouse-buffer-menu-alist
2014 0 : (cdr (cdr (car split-by-major-mode))))))
2015 0 : (and this-mode-list
2016 0 : (setq subdivided-menus
2017 0 : (cons (cons
2018 0 : (nth 1 (car split-by-major-mode))
2019 0 : this-mode-list)
2020 0 : subdivided-menus))))
2021 0 : (setq buffers-left
2022 0 : (- buffers-left (length (cdr (car split-by-major-mode)))))
2023 0 : (setq split-by-major-mode (cdr split-by-major-mode)))
2024 : ;; If any major modes are left over,
2025 : ;; make a single submenu for them.
2026 0 : (if split-by-major-mode
2027 0 : (let ((others-list
2028 0 : (mouse-buffer-menu-alist
2029 : ;; we don't need split-by-major-mode any more,
2030 : ;; so we can ditch it with nconc (mapcan).
2031 0 : (mapcan 'cddr split-by-major-mode))))
2032 0 : (and others-list
2033 0 : (setq subdivided-menus
2034 0 : (cons (cons "Others" others-list)
2035 0 : subdivided-menus)))))
2036 0 : (cons "Buffer Menu" (nreverse subdivided-menus)))
2037 0 : (cons "Buffer Menu"
2038 0 : (mouse-buffer-menu-split "Select Buffer"
2039 0 : (mouse-buffer-menu-alist buffers))))))
2040 :
2041 : (defun mouse-buffer-menu-alist (buffers)
2042 0 : (let (tail
2043 : (maxlen 0)
2044 : head)
2045 0 : (setq buffers
2046 0 : (sort buffers
2047 0 : (function (lambda (elt1 elt2)
2048 0 : (string< (buffer-name elt1) (buffer-name elt2))))))
2049 0 : (setq tail buffers)
2050 0 : (while tail
2051 0 : (or (eq ?\s (aref (buffer-name (car tail)) 0))
2052 0 : (setq maxlen
2053 0 : (max maxlen
2054 0 : (length (buffer-name (car tail))))))
2055 0 : (setq tail (cdr tail)))
2056 0 : (setq tail buffers)
2057 0 : (while tail
2058 0 : (let ((elt (car tail)))
2059 0 : (if (/= (aref (buffer-name elt) 0) ?\s)
2060 0 : (setq head
2061 0 : (cons
2062 0 : (cons
2063 0 : (format
2064 0 : (format "%%-%ds %%s%%s %%s" maxlen)
2065 0 : (buffer-name elt)
2066 0 : (if (buffer-modified-p elt) "*" " ")
2067 0 : (with-current-buffer elt
2068 0 : (if buffer-read-only "%" " "))
2069 0 : (or (buffer-file-name elt)
2070 0 : (with-current-buffer elt
2071 0 : (if list-buffers-directory
2072 0 : (expand-file-name
2073 0 : list-buffers-directory)))
2074 0 : ""))
2075 0 : elt)
2076 0 : head))))
2077 0 : (setq tail (cdr tail)))
2078 : ;; Compensate for the reversal that the above loop does.
2079 0 : (nreverse head)))
2080 :
2081 : (defun mouse-buffer-menu-split (title alist)
2082 : ;; If we have lots of buffers, divide them into groups of 20
2083 : ;; and make a pane (or submenu) for each one.
2084 0 : (if (> (length alist) (/ (* mouse-buffer-menu-maxlen 3) 2))
2085 0 : (let ((alist alist) sublists next
2086 : (i 1))
2087 0 : (while alist
2088 : ;; Pull off the next mouse-buffer-menu-maxlen buffers
2089 : ;; and make them the next element of sublist.
2090 0 : (setq next (nthcdr mouse-buffer-menu-maxlen alist))
2091 0 : (if next
2092 0 : (setcdr (nthcdr (1- mouse-buffer-menu-maxlen) alist)
2093 0 : nil))
2094 0 : (setq sublists (cons (cons (format "Buffers %d" i) alist)
2095 0 : sublists))
2096 0 : (setq i (1+ i))
2097 0 : (setq alist next))
2098 0 : (nreverse sublists))
2099 : ;; Few buffers--put them all in one pane.
2100 0 : (list (cons title alist))))
2101 :
2102 : (define-obsolete-function-alias
2103 : 'mouse-choose-completion 'choose-completion "23.2")
2104 :
2105 : ;; Font selection.
2106 :
2107 : (defun font-menu-add-default ()
2108 0 : (let* ((default (frame-parameter nil 'font))
2109 0 : (font-alist x-fixed-font-alist)
2110 0 : (elt (or (assoc "Misc" font-alist) (nth 1 font-alist))))
2111 0 : (if (assoc "Default" elt)
2112 0 : (delete (assoc "Default" elt) elt))
2113 0 : (setcdr elt
2114 0 : (cons (list "Default" default)
2115 0 : (cdr elt)))))
2116 :
2117 : (defvar x-fixed-font-alist
2118 : (list
2119 : (purecopy "Font Menu")
2120 : (cons
2121 : (purecopy "Misc")
2122 : (mapcar
2123 : (lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg))))
2124 : ;; For these, we specify the pixel height and width.
2125 : '(("fixed" "fixed")
2126 : ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10")
2127 : ("6x12"
2128 : "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12")
2129 : ("6x13"
2130 : "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13")
2131 : ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13")
2132 : ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14")
2133 : ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13")
2134 : ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15")
2135 : ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20")
2136 : ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18")
2137 : ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24")
2138 : ("")
2139 : ("clean 5x8"
2140 : "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1")
2141 : ("clean 6x8"
2142 : "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1")
2143 : ("clean 8x8"
2144 : "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1")
2145 : ("clean 8x10"
2146 : "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1")
2147 : ("clean 8x14"
2148 : "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1")
2149 : ("clean 8x16"
2150 : "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1")
2151 : ("")
2152 : ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1")
2153 : ;; We don't seem to have these; who knows what they are.
2154 : ;; ("fg-18" "fg-18")
2155 : ;; ("fg-25" "fg-25")
2156 : ("lucidasanstypewriter-12" "-b&h-lucidatypewriter-medium-r-normal-sans-*-120-*-*-*-*-iso8859-1")
2157 : ("lucidasanstypewriter-bold-14" "-b&h-lucidatypewriter-bold-r-normal-sans-*-140-*-*-*-*-iso8859-1")
2158 : ("lucidasanstypewriter-bold-24"
2159 : "-b&h-lucidatypewriter-bold-r-normal-sans-*-240-*-*-*-*-iso8859-1")
2160 : ;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1")
2161 : ;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
2162 : )))
2163 :
2164 : (cons
2165 : (purecopy "Courier")
2166 : (mapcar
2167 : (lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg))))
2168 : ;; For these, we specify the point height.
2169 : '(("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1")
2170 : ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1")
2171 : ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1")
2172 : ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1")
2173 : ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1")
2174 : ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1")
2175 : ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1")
2176 : ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1")
2177 : ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1")
2178 : ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1")
2179 : ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1")
2180 : ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1")
2181 : ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1")
2182 : ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1")
2183 : ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1")
2184 : ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1")
2185 : ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1")
2186 : ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1")
2187 : ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1")
2188 : ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1")
2189 : ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1")
2190 : ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1")
2191 : ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1")
2192 : ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1")
2193 : ))))
2194 : "X fonts suitable for use in Emacs.")
2195 :
2196 : (declare-function generate-fontset-menu "fontset" ())
2197 :
2198 : (defun mouse-select-font ()
2199 : "Prompt for a font name, using `x-popup-menu', and return it."
2200 : (interactive)
2201 0 : (unless (display-multi-font-p)
2202 0 : (error "Cannot change fonts on this display"))
2203 0 : (car
2204 0 : (x-popup-menu
2205 0 : (if (listp last-nonmenu-event)
2206 0 : last-nonmenu-event
2207 0 : (list '(0 0) (selected-window)))
2208 0 : (append x-fixed-font-alist
2209 0 : (list (generate-fontset-menu))))))
2210 :
2211 : (declare-function text-scale-mode "face-remap")
2212 :
2213 : (defun mouse-set-font (&rest fonts)
2214 : "Set the default font for the selected frame.
2215 : The argument FONTS is a list of font names; the first valid font
2216 : in this list is used.
2217 :
2218 : When called interactively, pop up a menu and allow the user to
2219 : choose a font."
2220 : (interactive
2221 0 : (progn (unless (display-multi-font-p)
2222 0 : (error "Cannot change fonts on this display"))
2223 0 : (x-popup-menu
2224 0 : (if (listp last-nonmenu-event)
2225 0 : last-nonmenu-event
2226 0 : (list '(0 0) (selected-window)))
2227 : ;; Append list of fontsets currently defined.
2228 0 : (append x-fixed-font-alist (list (generate-fontset-menu))))))
2229 0 : (if fonts
2230 0 : (let (font)
2231 0 : (while fonts
2232 0 : (condition-case nil
2233 0 : (progn
2234 0 : (set-frame-font (car fonts))
2235 0 : (setq font (car fonts))
2236 0 : (setq fonts nil))
2237 : (error
2238 0 : (setq fonts (cdr fonts)))))
2239 0 : (if (null font)
2240 0 : (error "Font not found")))))
2241 :
2242 : (defvar mouse-appearance-menu-map nil)
2243 : (declare-function x-select-font "xfns.c" (&optional frame ignored)) ; USE_GTK
2244 : (declare-function buffer-face-mode-invoke "face-remap"
2245 : (face arg &optional interactive))
2246 : (declare-function font-face-attributes "font.c" (font &optional frame))
2247 : (defvar w32-use-w32-font-dialog)
2248 : (defvar w32-fixed-font-alist)
2249 :
2250 : (defun mouse-appearance-menu (event)
2251 : "Show a menu for changing the default face in the current buffer."
2252 : (interactive "@e")
2253 0 : (require 'face-remap)
2254 0 : (when (display-multi-font-p)
2255 0 : (with-selected-window (car (event-start event))
2256 0 : (if mouse-appearance-menu-map
2257 : nil ; regenerate new fonts
2258 : ;; Initialize mouse-appearance-menu-map
2259 0 : (setq mouse-appearance-menu-map
2260 0 : (make-sparse-keymap "Change Default Buffer Face"))
2261 0 : (define-key mouse-appearance-menu-map [face-remap-reset-base]
2262 0 : '(menu-item "Reset to Default" face-remap-reset-base))
2263 0 : (define-key mouse-appearance-menu-map [text-scale-decrease]
2264 0 : '(menu-item "Decrease Buffer Text Size" text-scale-decrease))
2265 0 : (define-key mouse-appearance-menu-map [text-scale-increase]
2266 0 : '(menu-item "Increase Buffer Text Size" text-scale-increase))
2267 : ;; Font selector
2268 0 : (if (and (functionp 'x-select-font)
2269 0 : (or (not (boundp 'w32-use-w32-font-dialog))
2270 0 : w32-use-w32-font-dialog))
2271 0 : (define-key mouse-appearance-menu-map [x-select-font]
2272 0 : '(menu-item "Change Buffer Font..." x-select-font))
2273 : ;; If the select-font is unavailable, construct a menu.
2274 0 : (let ((font-submenu (make-sparse-keymap "Change Text Font"))
2275 0 : (font-alist (cdr (append
2276 0 : (if (eq system-type 'windows-nt)
2277 0 : w32-fixed-font-alist
2278 0 : x-fixed-font-alist)
2279 0 : (list (generate-fontset-menu))))))
2280 0 : (dolist (family font-alist)
2281 0 : (let* ((submenu-name (car family))
2282 0 : (submenu-map (make-sparse-keymap submenu-name)))
2283 0 : (dolist (font (cdr family))
2284 0 : (let ((font-name (car font))
2285 : font-symbol)
2286 0 : (if (string= font-name "")
2287 0 : (define-key submenu-map [space]
2288 0 : '("--"))
2289 0 : (setq font-symbol (intern (cadr font)))
2290 0 : (define-key submenu-map (vector font-symbol)
2291 0 : (list 'menu-item (car font) font-symbol)))))
2292 0 : (define-key font-submenu (vector (intern submenu-name))
2293 0 : (list 'menu-item submenu-name submenu-map))))
2294 0 : (define-key mouse-appearance-menu-map [font-submenu]
2295 0 : (list 'menu-item "Change Text Font" font-submenu)))))
2296 0 : (let ((choice (x-popup-menu event mouse-appearance-menu-map)))
2297 0 : (setq choice (nth (1- (length choice)) choice))
2298 0 : (cond ((eq choice 'text-scale-increase)
2299 0 : (text-scale-increase 1))
2300 0 : ((eq choice 'text-scale-decrease)
2301 0 : (text-scale-increase -1))
2302 0 : ((eq choice 'face-remap-reset-base)
2303 0 : (text-scale-mode 0)
2304 0 : (buffer-face-mode 0))
2305 0 : (choice
2306 : ;; Either choice == 'x-select-font, or choice is a
2307 : ;; symbol whose name is a font.
2308 0 : (let ((font (if (eq choice 'x-select-font)
2309 0 : (x-select-font)
2310 0 : (symbol-name choice))))
2311 0 : (buffer-face-mode-invoke
2312 0 : (if (fontp font 'font-spec)
2313 0 : (list :font font)
2314 0 : (font-face-attributes font))
2315 0 : t (called-interactively-p 'interactive)))))))))
2316 :
2317 :
2318 : ;; Drag and drop support.
2319 : (defcustom mouse-drag-and-drop-region nil
2320 : "If non-nil, dragging the mouse drags the region, if that exists.
2321 : If the value is a modifier, such as `control' or `shift' or `meta',
2322 : then if that modifier key is pressed when dropping the region, region
2323 : text is copied instead of being cut."
2324 : :type 'symbol
2325 : :version "26.1"
2326 : :group 'mouse)
2327 :
2328 : (defun mouse-drag-and-drop-region (event)
2329 : "Move text in the region to point where mouse is dragged to.
2330 : The transportation of text is also referred as `drag and drop'.
2331 : When text is dragged over to a different buffer, or if a
2332 : modifier key was pressed when dropping, and the value of the
2333 : variable `mouse-drag-and-drop-region' is that modifier, the text
2334 : is copied instead of being cut."
2335 : (interactive "e")
2336 0 : (require 'tooltip)
2337 0 : (let ((start (region-beginning))
2338 0 : (end (region-end))
2339 0 : (point (point))
2340 0 : (buffer (current-buffer))
2341 0 : (window (selected-window))
2342 : value-selection)
2343 0 : (track-mouse
2344 : ;; When event was click instead of drag, skip loop
2345 0 : (while (progn
2346 0 : (setq event (read-event))
2347 0 : (mouse-movement-p event))
2348 0 : (unless value-selection ; initialization
2349 0 : (delete-overlay mouse-secondary-overlay)
2350 0 : (setq value-selection (buffer-substring start end))
2351 0 : (move-overlay mouse-secondary-overlay start end)) ; (deactivate-mark)
2352 0 : (ignore-errors (deactivate-mark) ; care existing region in other window
2353 0 : (mouse-set-point event)
2354 0 : (tooltip-show value-selection)))
2355 0 : (tooltip-hide))
2356 : ;; Do not modify buffer under mouse when "event was click",
2357 : ;; "drag negligible", or
2358 : ;; "drag to read-only".
2359 0 : (if (or (equal (mouse-posn-property (event-end event) 'face) 'region) ; "event was click"
2360 0 : (member 'secondary-selection ; "drag negligible"
2361 0 : (mapcar (lambda (xxx) (overlay-get xxx 'face))
2362 0 : (overlays-at (posn-point (event-end event)))))
2363 0 : buffer-read-only)
2364 : ;; Do not modify buffer under mouse.
2365 0 : (cond
2366 : ;; "drag negligible" or "drag to read-only", restore region.
2367 0 : (value-selection
2368 0 : (select-window window) ; In case miss drag to other window
2369 0 : (goto-char point)
2370 0 : (setq deactivate-mark nil)
2371 0 : (activate-mark))
2372 : ;; "event was click"
2373 : (t
2374 0 : (deactivate-mark)
2375 0 : (mouse-set-point event)))
2376 : ;; Modify buffer under mouse by inserting text.
2377 0 : (push-mark)
2378 0 : (insert value-selection)
2379 0 : (when (not (equal (mark) (point))) ; on success insert
2380 0 : (setq deactivate-mark nil)
2381 0 : (activate-mark)) ; have region on destination
2382 : ;; Take care of initial region on source.
2383 0 : (if (equal (current-buffer) buffer) ; when same buffer
2384 0 : (let (deactivate-mark) ; remove text
2385 0 : (unless (member mouse-drag-and-drop-region (event-modifiers event))
2386 0 : (kill-region (overlay-start mouse-secondary-overlay)
2387 0 : (overlay-end mouse-secondary-overlay))))
2388 0 : (let ((window1 (selected-window))) ; when beyond buffer
2389 0 : (select-window window)
2390 0 : (goto-char point) ; restore point on source window
2391 0 : (activate-mark) ; restore region
2392 0 : (select-window window1))))
2393 0 : (delete-overlay mouse-secondary-overlay)))
2394 :
2395 :
2396 : ;;; Bindings for mouse commands.
2397 :
2398 : (global-set-key [down-mouse-1] 'mouse-drag-region)
2399 : (global-set-key [mouse-1] 'mouse-set-point)
2400 : (global-set-key [drag-mouse-1] 'mouse-set-region)
2401 :
2402 : (defun mouse--strip-first-event (_prompt)
2403 0 : (substring (this-single-command-raw-keys) 1))
2404 :
2405 : (define-key function-key-map [left-fringe mouse-1] 'mouse--strip-first-event)
2406 : (define-key function-key-map [right-fringe mouse-1] 'mouse--strip-first-event)
2407 :
2408 : (global-set-key [mouse-2] 'mouse-yank-primary)
2409 : ;; Allow yanking also when the corresponding cursor is "in the fringe".
2410 : (define-key function-key-map [right-fringe mouse-2] 'mouse--strip-first-event)
2411 : (define-key function-key-map [left-fringe mouse-2] 'mouse--strip-first-event)
2412 : (global-set-key [mouse-3] 'mouse-save-then-kill)
2413 : (define-key function-key-map [right-fringe mouse-3] 'mouse--strip-first-event)
2414 : (define-key function-key-map [left-fringe mouse-3] 'mouse--strip-first-event)
2415 :
2416 : ;; By binding these to down-going events, we let the user use the up-going
2417 : ;; event to make the selection, saving a click.
2418 : (global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
2419 : (if (not (eq system-type 'ms-dos))
2420 : (global-set-key [S-down-mouse-1] 'mouse-appearance-menu))
2421 : ;; C-down-mouse-2 is bound in facemenu.el.
2422 : (global-set-key [C-down-mouse-3]
2423 : `(menu-item ,(purecopy "Menu Bar") ignore
2424 : :filter (lambda (_)
2425 : (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0))
2426 : (mouse-menu-bar-map)
2427 : (mouse-menu-major-mode-map)))))
2428 :
2429 : ;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
2430 : ;; vertical-line prevents Emacs from signaling an error when the mouse
2431 : ;; button is released after dragging these lines, on non-toolkit
2432 : ;; versions.
2433 : (global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
2434 : (global-set-key [header-line mouse-1] 'mouse-select-window)
2435 : ;; (global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
2436 : (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
2437 : (global-set-key [mode-line mouse-1] 'mouse-select-window)
2438 : (global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
2439 : (global-set-key [mode-line mouse-3] 'mouse-delete-window)
2440 : (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
2441 : (global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
2442 : (global-set-key [horizontal-scroll-bar C-mouse-2] 'mouse-split-window-horizontally)
2443 : (global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
2444 : (global-set-key [vertical-line mouse-1] 'mouse-select-window)
2445 : (global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
2446 : (global-set-key [right-divider down-mouse-1] 'mouse-drag-vertical-line)
2447 : (global-set-key [right-divider mouse-1] 'ignore)
2448 : (global-set-key [right-divider C-mouse-2] 'mouse-split-window-vertically)
2449 : (global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
2450 : (global-set-key [bottom-divider mouse-1] 'ignore)
2451 : (global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
2452 : (global-set-key [left-edge down-mouse-1] 'mouse-drag-left-edge)
2453 : (global-set-key [left-edge mouse-1] 'ignore)
2454 : (global-set-key [top-left-corner down-mouse-1] 'mouse-drag-top-left-corner)
2455 : (global-set-key [top-left-corner mouse-1] 'ignore)
2456 : (global-set-key [top-edge down-mouse-1] 'mouse-drag-top-edge)
2457 : (global-set-key [top-edge mouse-1] 'ignore)
2458 : (global-set-key [top-right-corner down-mouse-1] 'mouse-drag-top-right-corner)
2459 : (global-set-key [top-right-corner mouse-1] 'ignore)
2460 : (global-set-key [right-edge down-mouse-1] 'mouse-drag-right-edge)
2461 : (global-set-key [right-edge mouse-1] 'ignore)
2462 : (global-set-key [bottom-right-corner down-mouse-1] 'mouse-drag-bottom-right-corner)
2463 : (global-set-key [bottom-right-corner mouse-1] 'ignore)
2464 : (global-set-key [bottom-edge down-mouse-1] 'mouse-drag-bottom-edge)
2465 : (global-set-key [bottom-edge mouse-1] 'ignore)
2466 : (global-set-key [bottom-left-corner down-mouse-1] 'mouse-drag-bottom-left-corner)
2467 : (global-set-key [bottom-left-corner mouse-1] 'ignore)
2468 :
2469 : (provide 'mouse)
2470 :
2471 : ;;; mouse.el ends here
|