13337
|
1 ;;; mouse.el --- window system-independent mouse support
|
791
|
2
|
64762
|
3 ;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
|
68651
|
4 ;; 2004, 2005, 2006 Free Software Foundation, Inc.
|
840
|
5
|
791
|
6 ;; Maintainer: FSF
|
30328
|
7 ;; Keywords: hardware, mouse
|
791
|
8
|
13337
|
9 ;; This file is part of GNU Emacs.
|
66
|
10
|
13337
|
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 2, or (at your option)
|
|
14 ;; any later version.
|
66
|
15
|
13337
|
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.
|
66
|
20
|
13337
|
21 ;; You should have received a copy of the GNU General Public License
|
14179
7db5b89b78b6
(mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64091
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
24 ;; Boston, MA 02110-1301, USA.
|
66
|
25
|
2308
|
26 ;;; Commentary:
|
|
27
|
|
28 ;; This package provides various useful commands (including help
|
|
29 ;; system access) through the mouse. All this code assumes that mouse
|
|
30 ;; interpretation has been abstracted into Emacs input events.
|
|
31 ;;
|
|
32 ;; The code is rather X-dependent.
|
|
33
|
2232
|
34 ;;; Code:
|
|
35
|
465
|
36 ;;; Utility functions.
|
|
37
|
|
38 ;;; Indent track-mouse like progn.
|
|
39 (put 'track-mouse 'lisp-indent-function 0)
|
66
|
40
|
17636
|
41 (defcustom mouse-yank-at-point nil
|
|
42 "*If non-nil, mouse yank commands yank at point instead of at click."
|
|
43 :type 'boolean
|
|
44 :group 'mouse)
|
55260
|
45
|
|
46 (defcustom mouse-drag-copy-region t
|
|
47 "*If non-nil, mouse drag copies region to kill-ring."
|
|
48 :type 'boolean
|
59996
|
49 :version "22.1"
|
55260
|
50 :group 'mouse)
|
|
51
|
61160
|
52 (defcustom mouse-1-click-follows-link 450
|
59036
|
53 "Non-nil means that clicking Mouse-1 on a link follows the link.
|
59016
|
54
|
59036
|
55 With the default setting, an ordinary Mouse-1 click on a link
|
|
56 performs the same action as Mouse-2 on that link, while a longer
|
66123
|
57 Mouse-1 click \(hold down the Mouse-1 button for more than 450
|
59036
|
58 milliseconds) performs the original Mouse-1 binding \(which
|
59016
|
59 typically sets point where you click the mouse).
|
|
60
|
|
61 If value is an integer, the time elapsed between pressing and
|
|
62 releasing the mouse button determines whether to follow the link
|
59036
|
63 or perform the normal Mouse-1 action (typically set point).
|
59016
|
64 The absolute numeric value specifices the maximum duration of a
|
|
65 \"short click\" in milliseconds. A positive value means that a
|
|
66 short click follows the link, and a longer click performs the
|
63256
|
67 normal action. A negative value gives the opposite behavior.
|
59016
|
68
|
|
69 If value is `double', a double click follows the link.
|
|
70
|
59036
|
71 Otherwise, a single Mouse-1 click unconditionally follows the link.
|
59016
|
72
|
|
73 Note that dragging the mouse never follows the link.
|
|
74
|
|
75 This feature only works in modes that specifically identify
|
|
76 clickable text as links, so it may not work with some external
|
|
77 packages. See `mouse-on-link-p' for details."
|
59996
|
78 :version "22.1"
|
59016
|
79 :type '(choice (const :tag "Disabled" nil)
|
|
80 (const :tag "Double click" double)
|
66123
|
81 (number :tag "Single click time limit" :value 450)
|
59016
|
82 (other :tag "Single click" t))
|
|
83 :group 'mouse)
|
|
84
|
60253
|
85 (defcustom mouse-1-click-in-non-selected-windows t
|
|
86 "*If non-nil, a Mouse-1 click also follows links in non-selected windows.
|
|
87
|
|
88 If nil, a Mouse-1 click on a link in a non-selected window performs
|
|
89 the normal mouse-1 binding, typically selects the window and sets
|
|
90 point at the click position."
|
|
91 :type 'boolean
|
|
92 :version "22.1"
|
|
93 :group 'mouse)
|
|
94
|
|
95
|
465
|
96
|
9488
|
97 ;; Provide a mode-specific menu on a mouse button.
|
|
98
|
30312
|
99 (defun popup-menu (menu &optional position prefix)
|
|
100 "Popup the given menu and call the selected option.
|
30328
|
101 MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
|
|
102 `x-popup-menu'.
|
30312
|
103 POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and defaults to
|
|
104 the current mouse position.
|
|
105 PREFIX is the prefix argument (if any) to pass to the command."
|
30328
|
106 (let* ((map (cond
|
|
107 ((keymapp menu) menu)
|
|
108 ((and (listp menu) (keymapp (car menu))) menu)
|
|
109 (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
|
33769
|
110 (filter (when (symbolp map)
|
|
111 (plist-get (get map 'menu-prop) :filter))))
|
|
112 (if filter (funcall filter (symbol-function map)) map)))))
|
32312
|
113 event cmd)
|
31912
|
114 (unless position
|
31923
|
115 (let ((mp (mouse-pixel-position)))
|
31912
|
116 (setq position (list (list (cadr mp) (cddr mp)) (car mp)))))
|
30312
|
117 ;; The looping behavior was taken from lmenu's popup-menu-popup
|
30421
|
118 (while (and map (setq event
|
|
119 ;; map could be a prefix key, in which case
|
|
120 ;; we need to get its function cell
|
|
121 ;; definition.
|
31923
|
122 (x-popup-menu position (indirect-function map))))
|
30312
|
123 ;; Strangely x-popup-menu returns a list.
|
|
124 ;; mouse-major-mode-menu was using a weird:
|
|
125 ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
|
32312
|
126 (setq cmd
|
|
127 (if (and (not (keymapp map)) (listp map))
|
|
128 ;; We were given a list of keymaps. Search them all
|
|
129 ;; in sequence until a first binding is found.
|
|
130 (let ((mouse-click (apply 'vector event))
|
|
131 binding)
|
|
132 (while (and map (null binding))
|
|
133 (setq binding (lookup-key (car map) mouse-click))
|
|
134 (if (numberp binding) ; `too long'
|
|
135 (setq binding nil))
|
|
136 (setq map (cdr map)))
|
|
137 binding)
|
|
138 ;; We were given a single keymap.
|
|
139 (lookup-key map (apply 'vector event))))
|
|
140 ;; Clear out echoing, which perhaps shows a prefix arg.
|
|
141 (message "")
|
|
142 ;; Maybe try again but with the submap.
|
|
143 (setq map (if (keymapp cmd) cmd)))
|
40648
|
144 ;; If the user did not cancel by refusing to select,
|
|
145 ;; and if the result is a command, run it.
|
|
146 (when (and (null map) (commandp cmd))
|
32312
|
147 (setq prefix-arg prefix)
|
|
148 ;; `setup-specified-language-environment', for instance,
|
|
149 ;; expects this to be set from a menu keymap.
|
|
150 (setq last-command-event (car (last event)))
|
|
151 ;; mouse-major-mode-menu was using `command-execute' instead.
|
32319
|
152 (call-interactively cmd))))
|
30425
|
153
|
|
154 (defvar mouse-major-mode-menu-prefix) ; dynamically bound
|
|
155
|
65498
|
156 (defun mouse-major-mode-menu (event &optional prefix)
|
24960
|
157 "Pop up a mode-specific menu of mouse commands.
|
|
158 Default to the Edit menu if the major mode doesn't define a menu."
|
9488
|
159 ;; Switch to the window clicked on, because otherwise
|
|
160 ;; the mode's commands may not make sense.
|
16621
|
161 (interactive "@e\nP")
|
21953
|
162 ;; Let the mode update its menus first.
|
31390
|
163 (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
|
24960
|
164 (let* (;; This is where mouse-major-mode-menu-prefix
|
|
165 ;; returns the prefix we should use (after menu-bar).
|
|
166 ;; It is either nil or (SOME-SYMBOL).
|
|
167 (mouse-major-mode-menu-prefix nil)
|
|
168 ;; Keymap from which to inherit; may be null.
|
|
169 (ancestor (mouse-major-mode-menu-1
|
|
170 (and (current-local-map)
|
31258
|
171 (local-key-binding [menu-bar]))))
|
24960
|
172 ;; Make a keymap in which our last command leads to a menu or
|
|
173 ;; default to the edit menu.
|
|
174 (newmap (if ancestor
|
|
175 (make-sparse-keymap (concat mode-name " Mode"))
|
65498
|
176 menu-bar-edit-menu)))
|
24960
|
177 (if ancestor
|
|
178 ;; Make our menu inherit from the desired keymap which we want
|
|
179 ;; to display as the menu now.
|
|
180 (set-keymap-parent newmap ancestor))
|
30312
|
181 (popup-menu newmap event prefix)))
|
|
182
|
9488
|
183
|
|
184 ;; Compute and cache the equivalent keys in MENU and all its submenus.
|
15642
|
185 ;;;(defun mouse-major-mode-menu-compute-equiv-keys (menu)
|
|
186 ;;; (and (eq (car menu) 'keymap)
|
|
187 ;;; (x-popup-menu nil menu))
|
|
188 ;;; (while menu
|
|
189 ;;; (and (consp (car menu))
|
|
190 ;;; (consp (cdr (car menu)))
|
|
191 ;;; (let ((tail (cdr (car menu))))
|
|
192 ;;; (while (and (consp tail)
|
|
193 ;;; (not (eq (car tail) 'keymap)))
|
|
194 ;;; (setq tail (cdr tail)))
|
|
195 ;;; (if (consp tail)
|
|
196 ;;; (mouse-major-mode-menu-compute-equiv-keys tail))))
|
|
197 ;;; (setq menu (cdr menu))))
|
9488
|
198
|
|
199 ;; Given a mode's menu bar keymap,
|
|
200 ;; if it defines exactly one menu bar menu,
|
|
201 ;; return just that menu.
|
|
202 ;; Otherwise return a menu for all of them.
|
|
203 (defun mouse-major-mode-menu-1 (menubar)
|
|
204 (if menubar
|
|
205 (let ((tail menubar)
|
|
206 submap)
|
|
207 (while tail
|
|
208 (if (consp (car tail))
|
|
209 (if submap
|
|
210 (setq submap t)
|
15642
|
211 (setq submap (car tail))))
|
9488
|
212 (setq tail (cdr tail)))
|
15642
|
213 (if (eq submap t)
|
15657
|
214 menubar
|
15642
|
215 (setq mouse-major-mode-menu-prefix (list (car submap)))
|
30249
fb30df0ff4ab
(mouse-major-mode-menu-1): get the submenu with lookup-key.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
216 (lookup-key menubar (vector (car submap)))))))
|
30328
|
217
|
|
218 (defun mouse-popup-menubar (event prefix)
|
52405
|
219 "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
|
30328
|
220 The contents are the items that would be in the menu bar whether or
|
|
221 not it is actually displayed."
|
|
222 (interactive "@e \nP")
|
31390
|
223 (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
|
30421
|
224 (let* ((local-menu (and (current-local-map)
|
|
225 (lookup-key (current-local-map) [menu-bar])))
|
|
226 (global-menu (lookup-key global-map [menu-bar]))
|
31329
|
227 ;; If a keymap doesn't have a prompt string (a lazy
|
|
228 ;; programmer didn't bother to provide one), create it and
|
|
229 ;; insert it into the keymap; each keymap gets its own
|
|
230 ;; prompt. This is required for non-toolkit versions to
|
|
231 ;; display non-empty menu pane names.
|
|
232 (minor-mode-menus
|
|
233 (mapcar
|
|
234 (function
|
|
235 (lambda (menu)
|
|
236 (let* ((minor-mode (car menu))
|
|
237 (menu (cdr menu))
|
|
238 (title-or-map (cadr menu)))
|
|
239 (or (stringp title-or-map)
|
|
240 (setq menu
|
|
241 (cons 'keymap
|
|
242 (cons (concat
|
|
243 (capitalize (subst-char-in-string
|
|
244 ?- ?\ (symbol-name
|
|
245 minor-mode)))
|
|
246 " Menu")
|
|
247 (cdr menu)))))
|
|
248 menu)))
|
|
249 (minor-mode-key-binding [menu-bar])))
|
30421
|
250 (local-title-or-map (and local-menu (cadr local-menu)))
|
|
251 (global-title-or-map (cadr global-menu)))
|
|
252 (or (null local-menu)
|
|
253 (stringp local-title-or-map)
|
|
254 (setq local-menu (cons 'keymap
|
|
255 (cons (concat mode-name " Mode Menu")
|
|
256 (cdr local-menu)))))
|
|
257 (or (stringp global-title-or-map)
|
|
258 (setq global-menu (cons 'keymap
|
|
259 (cons "Global Menu"
|
|
260 (cdr global-menu)))))
|
30328
|
261 ;; Supplying the list is faster than making a new map.
|
31258
|
262 (popup-menu (append (list global-menu)
|
|
263 (if local-menu
|
|
264 (list local-menu))
|
|
265 minor-mode-menus)
|
30421
|
266 event prefix)))
|
30328
|
267
|
|
268 (defun mouse-popup-menubar-stuff (event prefix)
|
|
269 "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
|
|
270 Use the former if the menu bar is showing, otherwise the latter."
|
|
271 (interactive "@e \nP")
|
|
272 (if (zerop (assoc-default 'menu-bar-lines (frame-parameters) 'eq 0))
|
|
273 (mouse-popup-menubar event prefix)
|
|
274 (mouse-major-mode-menu event prefix)))
|
9488
|
275
|
8519
|
276 ;; Commands that operate on windows.
|
|
277
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
278 (defun mouse-minibuffer-check (event)
|
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
279 (let ((w (posn-window (event-start event))))
|
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
280 (and (window-minibuffer-p w)
|
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
281 (not (minibuffer-window-active-p w))
|
10258
|
282 (error "Minibuffer window is not active")))
|
|
283 ;; Give temporary modes such as isearch a chance to turn off.
|
|
284 (run-hooks 'mouse-leave-buffer-hook))
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
285
|
465
|
286 (defun mouse-delete-window (click)
|
1214
|
287 "Delete the window you click on.
|
38763
|
288 Do nothing if the frame has just one window.
|
22845
|
289 This command must be bound to a mouse click."
|
1113
|
290 (interactive "e")
|
38763
|
291 (unless (one-window-p t)
|
22845
|
292 (mouse-minibuffer-check click)
|
|
293 (delete-window (posn-window (event-start click)))))
|
465
|
294
|
6090
|
295 (defun mouse-select-window (click)
|
|
296 "Select the window clicked on; don't move point."
|
|
297 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
298 (mouse-minibuffer-check click)
|
6090
|
299 (let ((oframe (selected-frame))
|
|
300 (frame (window-frame (posn-window (event-start click)))))
|
|
301 (select-window (posn-window (event-start click)))
|
|
302 (raise-frame frame)
|
|
303 (select-frame frame)
|
|
304 (or (eq frame oframe)
|
16087
|
305 (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
|
6090
|
306
|
1421
|
307 (defun mouse-tear-off-window (click)
|
|
308 "Delete the window clicked on, and create a new frame displaying its buffer."
|
|
309 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
310 (mouse-minibuffer-check click)
|
1421
|
311 (let* ((window (posn-window (event-start click)))
|
|
312 (buf (window-buffer window))
|
7363
|
313 (frame (make-frame)))
|
1421
|
314 (select-frame frame)
|
|
315 (switch-to-buffer buf)
|
|
316 (delete-window window)))
|
|
317
|
1363
|
318 (defun mouse-delete-other-windows ()
|
37741
|
319 "Delete all windows except the one you click on."
|
1363
|
320 (interactive "@")
|
66
|
321 (delete-other-windows))
|
|
322
|
465
|
323 (defun mouse-split-window-vertically (click)
|
|
324 "Select Emacs window mouse is on, then split it vertically in half.
|
|
325 The window is split at the line clicked on.
|
|
326 This command must be bound to a mouse click."
|
1214
|
327 (interactive "@e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
328 (mouse-minibuffer-check click)
|
1363
|
329 (let ((start (event-start click)))
|
|
330 (select-window (posn-window start))
|
7637
cc55e77a9819
(mouse-split-window-vertically): Treat scroll bar events just like others.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
331 (let ((new-height (1+ (cdr (posn-col-row (event-end click)))))
|
1980
|
332 (first-line window-min-height)
|
|
333 (last-line (- (window-height) window-min-height)))
|
|
334 (if (< last-line first-line)
|
8426
|
335 (error "Window too short to split")
|
1980
|
336 (split-window-vertically
|
|
337 (min (max new-height first-line) last-line))))))
|
66
|
338
|
1214
|
339 (defun mouse-split-window-horizontally (click)
|
|
340 "Select Emacs window mouse is on, then split it horizontally in half.
|
|
341 The window is split at the column clicked on.
|
|
342 This command must be bound to a mouse click."
|
|
343 (interactive "@e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
344 (mouse-minibuffer-check click)
|
1980
|
345 (let ((start (event-start click)))
|
|
346 (select-window (posn-window start))
|
|
347 (let ((new-width (1+ (car (posn-col-row (event-end click)))))
|
|
348 (first-col window-min-width)
|
|
349 (last-col (- (window-width) window-min-width)))
|
|
350 (if (< last-col first-col)
|
8426
|
351 (error "Window too narrow to split")
|
1980
|
352 (split-window-horizontally
|
|
353 (min (max new-width first-col) last-col))))))
|
1214
|
354
|
42399
|
355 (defun mouse-drag-window-above (window)
|
|
356 "Return the (or a) window directly above WINDOW.
|
|
357 That means one whose bottom edge is at the same height as WINDOW's top edge."
|
67954
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
358 (let ((start-top (nth 1 (window-edges window)))
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
359 (start-left (nth 0 (window-edges window)))
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
360 (start-right (nth 2 (window-edges window)))
|
42399
|
361 (start-window window)
|
|
362 above-window)
|
|
363 (setq window (previous-window window 0))
|
|
364 (while (and (not above-window) (not (eq window start-window)))
|
67954
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
365 (let ((left (nth 0 (window-edges window)))
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
366 (right (nth 2 (window-edges window))))
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
367 (when (and (= (+ (window-height window) (nth 1 (window-edges window)))
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
368 start-top)
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
369 (or (and (<= left start-left) (<= start-right right))
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
370 (and (<= start-left left) (<= left start-right))
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
371 (and (<= start-left right) (<= right start-right))))
|
f223df02d351
(mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
372 (setq above-window window)))
|
42399
|
373 (setq window (previous-window window)))
|
|
374 above-window))
|
|
375
|
|
376 (defun mouse-drag-move-window-bottom (window growth)
|
|
377 "Move the bottom of WINDOW up or down by GROWTH lines.
|
|
378 Move it down if GROWTH is positive, or up if GROWTH is negative.
|
|
379 If this would make WINDOW too short,
|
|
380 shrink the window or windows above it to make room."
|
67158
2c91c2e7af3a
(mouse-drag-move-window-bottom): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
381 (condition-case nil
|
2c91c2e7af3a
(mouse-drag-move-window-bottom): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
382 (adjust-window-trailing-edge window growth nil)
|
2c91c2e7af3a
(mouse-drag-move-window-bottom): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
383 (error nil)))
|
42399
|
384
|
57569
|
385 (defsubst mouse-drag-move-window-top (window growth)
|
|
386 "Move the top of WINDOW up or down by GROWTH lines.
|
|
387 Move it down if GROWTH is positive, or up if GROWTH is negative.
|
|
388 If this would make WINDOW too short, shrink the window or windows
|
|
389 above it to make room."
|
|
390 ;; Moving the top of WINDOW is actually moving the bottom of the
|
|
391 ;; window above.
|
|
392 (let ((window-above (mouse-drag-window-above window)))
|
|
393 (and window-above
|
|
394 (mouse-drag-move-window-bottom window-above (- growth)))))
|
|
395
|
25618
|
396 (defun mouse-drag-mode-line-1 (start-event mode-line-p)
|
|
397 "Change the height of a window by dragging on the mode or header line.
|
|
398 START-EVENT is the starting mouse-event of the drag action.
|
42399
|
399 MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
|
10258
|
400 ;; Give temporary modes such as isearch a chance to turn off.
|
|
401 (run-hooks 'mouse-leave-buffer-hook)
|
32207
|
402 (let* ((done nil)
|
|
403 (echo-keystrokes 0)
|
|
404 (start (event-start start-event))
|
|
405 (start-event-window (posn-window start))
|
|
406 (start-event-frame (window-frame start-event-window))
|
|
407 (start-nwindows (count-windows t))
|
|
408 (minibuffer (frame-parameter nil 'minibuffer))
|
|
409 should-enlarge-minibuffer event mouse y top bot edges wconfig growth)
|
8519
|
410 (track-mouse
|
|
411 (progn
|
|
412 ;; enlarge-window only works on the selected window, so
|
|
413 ;; we must select the window where the start event originated.
|
|
414 ;; unwind-protect will restore the old selected window later.
|
|
415 (select-window start-event-window)
|
40268
|
416
|
8519
|
417 ;; if this is the bottommost ordinary window, then to
|
|
418 ;; move its modeline the minibuffer must be enlarged.
|
|
419 (setq should-enlarge-minibuffer
|
|
420 (and minibuffer
|
25618
|
421 mode-line-p
|
8519
|
422 (not (one-window-p t))
|
|
423 (= (nth 1 (window-edges minibuffer))
|
|
424 (nth 3 (window-edges)))))
|
40268
|
425
|
8519
|
426 ;; loop reading events and sampling the position of
|
|
427 ;; the mouse.
|
|
428 (while (not done)
|
|
429 (setq event (read-event)
|
|
430 mouse (mouse-position))
|
40268
|
431
|
8519
|
432 ;; do nothing if
|
|
433 ;; - there is a switch-frame event.
|
|
434 ;; - the mouse isn't in the frame that we started in
|
|
435 ;; - the mouse isn't in any Emacs frame
|
|
436 ;; drag if
|
|
437 ;; - there is a mouse-movement event
|
|
438 ;; - there is a scroll-bar-movement event
|
|
439 ;; (same as mouse movement for our purposes)
|
|
440 ;; quit if
|
|
441 ;; - there is a keyboard event or some other unknown event
|
|
442 ;; unknown event.
|
|
443 (cond ((integerp event)
|
|
444 (setq done t))
|
40268
|
445
|
59470
f009f3970cd9
(mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
446 ((memq (car event) '(switch-frame select-window))
|
8519
|
447 nil)
|
40268
|
448
|
32207
|
449 ((not (memq (car event) '(mouse-movement scroll-bar-movement)))
|
|
450 (when (consp event)
|
|
451 (push event unread-command-events))
|
8519
|
452 (setq done t))
|
40268
|
453
|
8519
|
454 ((not (eq (car mouse) start-event-frame))
|
|
455 nil)
|
40268
|
456
|
8519
|
457 ((null (car (cdr mouse)))
|
|
458 nil)
|
40268
|
459
|
8519
|
460 (t
|
|
461 (setq y (cdr (cdr mouse))
|
|
462 edges (window-edges)
|
|
463 top (nth 1 edges)
|
|
464 bot (nth 3 edges))
|
40268
|
465
|
8519
|
466 ;; compute size change needed
|
25618
|
467 (cond (mode-line-p
|
|
468 (setq growth (- y bot -1)))
|
32269
|
469 (t ; header line
|
|
470 (when (< (- bot y) window-min-height)
|
|
471 (setq y (- bot window-min-height)))
|
|
472 ;; The window's top includes the header line!
|
|
473 (setq growth (- top y))))
|
25618
|
474 (setq wconfig (current-window-configuration))
|
40268
|
475
|
16636
|
476 ;; Check for an error case.
|
32207
|
477 (when (and (/= growth 0)
|
|
478 (not minibuffer)
|
|
479 (one-window-p t))
|
|
480 (error "Attempt to resize sole window"))
|
40268
|
481
|
8519
|
482 ;; grow/shrink minibuffer?
|
|
483 (if should-enlarge-minibuffer
|
68858
|
484 (unless resize-mini-windows
|
|
485 (mouse-drag-move-window-bottom start-event-window growth))
|
8519
|
486 ;; no. grow/shrink the selected window
|
32207
|
487 ;(message "growth = %d" growth)
|
57569
|
488 (if mode-line-p
|
|
489 (mouse-drag-move-window-bottom start-event-window growth)
|
|
490 (mouse-drag-move-window-top start-event-window growth)))
|
40268
|
491
|
8519
|
492 ;; if this window's growth caused another
|
|
493 ;; window to be deleted because it was too
|
|
494 ;; short, rescind the change.
|
|
495 ;;
|
|
496 ;; if size change caused space to be stolen
|
|
497 ;; from a window above this one, rescind the
|
30249
fb30df0ff4ab
(mouse-major-mode-menu-1): get the submenu with lookup-key.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
498 ;; change, but only if we didn't grow/shrink
|
8519
|
499 ;; the minibuffer. minibuffer size changes
|
|
500 ;; can cause all windows to shrink... no way
|
|
501 ;; around it.
|
32207
|
502 (when (or (/= start-nwindows (count-windows t))
|
|
503 (and (not should-enlarge-minibuffer)
|
42399
|
504 (> growth 0)
|
32207
|
505 mode-line-p
|
|
506 (/= top (nth 1 (window-edges)))))
|
|
507 (set-window-configuration wconfig)))))))))
|
25618
|
508
|
|
509 (defun mouse-drag-mode-line (start-event)
|
|
510 "Change the height of a window by dragging on the mode line."
|
|
511 (interactive "e")
|
|
512 (mouse-drag-mode-line-1 start-event t))
|
|
513
|
|
514 (defun mouse-drag-header-line (start-event)
|
32207
|
515 "Change the height of a window by dragging on the header line.
|
|
516 Windows whose header-lines are at the top of the frame cannot be
|
|
517 resized by dragging their header-line."
|
25618
|
518 (interactive "e")
|
32207
|
519 ;; Changing the window's size by dragging its header-line when the
|
|
520 ;; header-line is at the top of the frame is somewhat strange,
|
|
521 ;; because the header-line doesn't move, so don't do it.
|
|
522 (let* ((start (event-start start-event))
|
|
523 (window (posn-window start))
|
|
524 (frame (window-frame window))
|
|
525 (first-window (frame-first-window frame)))
|
65349
|
526 (unless (or (eq window first-window)
|
|
527 (= (nth 1 (window-edges window))
|
|
528 (nth 1 (window-edges first-window))))
|
|
529 (mouse-drag-mode-line-1 start-event nil))))
|
25618
|
530
|
8519
|
531
|
13038
|
532 (defun mouse-drag-vertical-line (start-event)
|
|
533 "Change the width of a window by dragging on the vertical line."
|
|
534 (interactive "e")
|
|
535 ;; Give temporary modes such as isearch a chance to turn off.
|
|
536 (run-hooks 'mouse-leave-buffer-hook)
|
20686
|
537 (let* ((done nil)
|
|
538 (echo-keystrokes 0)
|
|
539 (start-event-frame (window-frame (car (car (cdr start-event)))))
|
|
540 (start-event-window (car (car (cdr start-event))))
|
|
541 event mouse x left right edges wconfig growth
|
|
542 (which-side
|
|
543 (or (cdr (assq 'vertical-scroll-bars (frame-parameters start-event-frame)))
|
|
544 'right)))
|
69514
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
545 (cond
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
546 ((one-window-p t)
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
547 (error "Attempt to resize sole ordinary window"))
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
548 ((and (eq which-side 'right)
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
549 (>= (nth 2 (window-inside-edges start-event-window))
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
550 (frame-width start-event-frame)))
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
551 (error "Attempt to drag rightmost scrollbar"))
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
552 ((and (eq which-side 'left)
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
553 (= (nth 0 (window-inside-edges start-event-window)) 0))
|
4540a0223bcc
* mouse.el (mouse-drag-vertical-line): Use window-inside-edges
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
554 (error "Attempt to drag leftmost scrollbar")))
|
13038
|
555 (track-mouse
|
|
556 (progn
|
|
557 ;; enlarge-window only works on the selected window, so
|
|
558 ;; we must select the window where the start event originated.
|
|
559 ;; unwind-protect will restore the old selected window later.
|
|
560 (select-window start-event-window)
|
|
561 ;; loop reading events and sampling the position of
|
|
562 ;; the mouse.
|
|
563 (while (not done)
|
|
564 (setq event (read-event)
|
|
565 mouse (mouse-position))
|
|
566 ;; do nothing if
|
|
567 ;; - there is a switch-frame event.
|
|
568 ;; - the mouse isn't in the frame that we started in
|
|
569 ;; - the mouse isn't in any Emacs frame
|
|
570 ;; drag if
|
|
571 ;; - there is a mouse-movement event
|
|
572 ;; - there is a scroll-bar-movement event
|
|
573 ;; (same as mouse movement for our purposes)
|
|
574 ;; quit if
|
|
575 ;; - there is a keyboard event or some other unknown event
|
|
576 ;; unknown event.
|
|
577 (cond ((integerp event)
|
|
578 (setq done t))
|
59470
f009f3970cd9
(mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
579 ((memq (car event) '(switch-frame select-window))
|
13038
|
580 nil)
|
|
581 ((not (memq (car event)
|
|
582 '(mouse-movement scroll-bar-movement)))
|
|
583 (if (consp event)
|
|
584 (setq unread-command-events
|
|
585 (cons event unread-command-events)))
|
|
586 (setq done t))
|
|
587 ((not (eq (car mouse) start-event-frame))
|
|
588 nil)
|
|
589 ((null (car (cdr mouse)))
|
|
590 nil)
|
|
591 (t
|
67524
|
592 (let ((window
|
|
593 ;; If the scroll bar is on the window's left,
|
|
594 ;; adjust the window on the left.
|
|
595 (if (eq which-side 'right)
|
|
596 (selected-window)
|
|
597 (previous-window))))
|
20124
|
598 (setq x (- (car (cdr mouse))
|
23854
|
599 (if (eq which-side 'right) 0 2))
|
67524
|
600 edges (window-edges window)
|
20124
|
601 left (nth 0 edges)
|
|
602 right (nth 2 edges))
|
|
603 ;; scale back a move that would make the
|
|
604 ;; window too thin.
|
|
605 (if (< (- x left -1) window-min-width)
|
|
606 (setq x (+ left window-min-width -1)))
|
|
607 ;; compute size change needed
|
67524
|
608 (setq growth (- x right -1))
|
|
609 (condition-case nil
|
|
610 (adjust-window-trailing-edge window growth t)
|
|
611 (error nil))))))))))
|
13038
|
612
|
4554
|
613 (defun mouse-set-point (event)
|
465
|
614 "Move point to the position clicked on with the mouse.
|
4554
|
615 This should be bound to a mouse click event type."
|
1113
|
616 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
617 (mouse-minibuffer-check event)
|
4554
|
618 ;; Use event-end in case called from mouse-drag-region.
|
|
619 ;; If EVENT is a click, event-end and event-start give same value.
|
54867
|
620 (posn-set-point (event-end event)))
|
66
|
621
|
10720
|
622 (defvar mouse-last-region-beg nil)
|
|
623 (defvar mouse-last-region-end nil)
|
|
624 (defvar mouse-last-region-tick nil)
|
|
625
|
|
626 (defun mouse-region-match ()
|
|
627 "Return non-nil if there's an active region that was set with the mouse."
|
|
628 (and (mark t) mark-active
|
|
629 (eq mouse-last-region-beg (region-beginning))
|
|
630 (eq mouse-last-region-end (region-end))
|
|
631 (eq mouse-last-region-tick (buffer-modified-tick))))
|
|
632
|
1420
|
633 (defun mouse-set-region (click)
|
4738
|
634 "Set the region to the text dragged over, and copy to kill ring.
|
4554
|
635 This should be bound to a mouse drag event."
|
1420
|
636 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
637 (mouse-minibuffer-check click)
|
1420
|
638 (let ((posn (event-start click))
|
|
639 (end (event-end click)))
|
|
640 (select-window (posn-window posn))
|
|
641 (if (numberp (posn-point posn))
|
|
642 (goto-char (posn-point posn)))
|
2799
|
643 ;; If mark is highlighted, no need to bounce the cursor.
|
12078
|
644 ;; On X, we highlight while dragging, thus once again no need to bounce.
|
|
645 (or transient-mark-mode
|
66180
c80a3a047c83
(mouse-set-region): Don't do sit-for on a mac frame.
YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
diff
changeset
|
646 (memq (framep (selected-frame)) '(x pc w32 mac))
|
2799
|
647 (sit-for 1))
|
1420
|
648 (push-mark)
|
2802
|
649 (set-mark (point))
|
1420
|
650 (if (numberp (posn-point end))
|
4738
|
651 (goto-char (posn-point end)))
|
|
652 ;; Don't set this-command to kill-region, so that a following
|
|
653 ;; C-w will not double the text in the kill ring.
|
12257
|
654 ;; Ignore last-command so we don't append to a preceding kill.
|
55260
|
655 (when mouse-drag-copy-region
|
|
656 (let (this-command last-command deactivate-mark)
|
|
657 (copy-region-as-kill (mark) (point))))
|
10720
|
658 (mouse-set-region-1)))
|
|
659
|
|
660 (defun mouse-set-region-1 ()
|
55803
9070d5f984ea
(mouse-set-region-1): Use temporary transient-mark-mode
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
661 ;; Set transient-mark-mode for a little while.
|
56379
|
662 (if (memq transient-mark-mode '(nil identity))
|
|
663 (setq transient-mark-mode 'only))
|
10720
|
664 (setq mouse-last-region-beg (region-beginning))
|
|
665 (setq mouse-last-region-end (region-end))
|
|
666 (setq mouse-last-region-tick (buffer-modified-tick)))
|
1420
|
667
|
17636
|
668 (defcustom mouse-scroll-delay 0.25
|
3928
|
669 "*The pause between scroll steps caused by mouse drags, in seconds.
|
|
670 If you drag the mouse beyond the edge of a window, Emacs scrolls the
|
|
671 window to bring the text beyond that edge into view, with a delay of
|
|
672 this many seconds between scroll steps. Scrolling stops when you move
|
|
673 the mouse back into the window, or release the button.
|
|
674 This variable's value may be non-integral.
|
17636
|
675 Setting this to zero causes Emacs to scroll as fast as it can."
|
|
676 :type 'number
|
|
677 :group 'mouse)
|
3928
|
678
|
17636
|
679 (defcustom mouse-scroll-min-lines 1
|
13068
|
680 "*The minimum number of lines scrolled by dragging mouse out of window.
|
|
681 Moving the mouse out the top or bottom edge of the window begins
|
|
682 scrolling repeatedly. The number of lines scrolled per repetition
|
|
683 is normally equal to the number of lines beyond the window edge that
|
|
684 the mouse has moved. However, it always scrolls at least the number
|
17636
|
685 of lines specified by this variable."
|
|
686 :type 'integer
|
|
687 :group 'mouse)
|
13038
|
688
|
7932
|
689 (defun mouse-scroll-subr (window jump &optional overlay start)
|
|
690 "Scroll the window WINDOW, JUMP lines at a time, until new input arrives.
|
3928
|
691 If OVERLAY is an overlay, let it stretch from START to the far edge of
|
|
692 the newly visible text.
|
|
693 Upon exit, point is at the far edge of the newly visible text."
|
13038
|
694 (cond
|
|
695 ((and (> jump 0) (< jump mouse-scroll-min-lines))
|
|
696 (setq jump mouse-scroll-min-lines))
|
|
697 ((and (< jump 0) (< (- jump) mouse-scroll-min-lines))
|
|
698 (setq jump (- mouse-scroll-min-lines))))
|
7966
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
699 (let ((opoint (point)))
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
700 (while (progn
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
701 (goto-char (window-start window))
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
702 (if (not (zerop (vertical-motion jump window)))
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
703 (progn
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
704 (set-window-start window (point))
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
705 (if (natnump jump)
|
21176
|
706 (if (window-end window)
|
|
707 (progn
|
|
708 (goto-char (window-end window))
|
|
709 ;; window-end doesn't reflect the window's new
|
|
710 ;; start position until the next redisplay.
|
|
711 (vertical-motion (1- jump) window))
|
|
712 (vertical-motion (- (window-height window) 2)))
|
7966
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
713 (goto-char (window-start window)))
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
714 (if overlay
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
715 (move-overlay overlay start (point)))
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
716 ;; Now that we have scrolled WINDOW properly,
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
717 ;; put point back where it was for the redisplay
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
718 ;; so that we don't mess up the selected window.
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
719 (or (eq window (selected-window))
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
720 (goto-char opoint))
|
8064
|
721 (sit-for mouse-scroll-delay)))))
|
7966
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
722 (or (eq window (selected-window))
|
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
723 (goto-char opoint))))
|
3928
|
724
|
11453
|
725 ;; Create an overlay and immediately delete it, to get "overlay in no buffer".
|
65640
|
726 (defconst mouse-drag-overlay
|
|
727 (let ((ol (make-overlay (point-min) (point-min))))
|
|
728 (delete-overlay ol)
|
|
729 (overlay-put ol 'face 'region)
|
|
730 ol))
|
3928
|
731
|
5027
|
732 (defvar mouse-selection-click-count 0)
|
4751
|
733
|
12436
|
734 (defvar mouse-selection-click-count-buffer nil)
|
|
735
|
3928
|
736 (defun mouse-drag-region (start-event)
|
2799
|
737 "Set the region to the text that the mouse is dragged over.
|
4532
|
738 Highlight the drag area as you move the mouse.
|
|
739 This must be bound to a button-down mouse event.
|
15116
|
740 In Transient Mark mode, the highlighting remains as long as the mark
|
42806
|
741 remains active. Otherwise, it remains until the next input event.
|
|
742
|
|
743 If the click is in the echo area, display the `*Messages*' buffer."
|
3566
|
744 (interactive "e")
|
59470
f009f3970cd9
(mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
745 (let ((w (posn-window (event-start start-event))))
|
f009f3970cd9
(mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
746 (if (and (window-minibuffer-p w)
|
f009f3970cd9
(mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
747 (not (minibuffer-window-active-p w)))
|
42806
|
748 (save-excursion
|
59526
|
749 ;; Swallow the up-event.
|
42806
|
750 (read-event)
|
66322
e921fbeaaddb
2005-10-23 MIYOSHI Masanori <miyoshi@meadowy.org> (tiny change)
Romain Francoise <romain@orebokech.com>
diff
changeset
|
751 (set-buffer (get-buffer-create "*Messages*"))
|
42806
|
752 (goto-char (point-max))
|
|
753 (display-buffer (current-buffer)))
|
|
754 ;; Give temporary modes such as isearch a chance to turn off.
|
|
755 (run-hooks 'mouse-leave-buffer-hook)
|
67997
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
756 (mouse-drag-track start-event t))))
|
42806
|
757
|
59016
|
758
|
|
759 (defun mouse-on-link-p (pos)
|
|
760 "Return non-nil if POS is on a link in the current buffer.
|
60204
|
761 POS must be a buffer position in the current buffer or an mouse
|
|
762 event location in the selected window, see `event-start'.
|
60253
|
763 However, if `mouse-1-click-in-non-selected-windows' is non-nil,
|
|
764 POS may be a mouse event location in any window.
|
59016
|
765
|
|
766 A clickable link is identified by one of the following methods:
|
|
767
|
59500
|
768 - If the character at POS has a non-nil `follow-link' text or
|
61376
|
769 overlay property, the value of that property determines what to do.
|
59016
|
770
|
59500
|
771 - If there is a local key-binding or a keybinding at position POS
|
|
772 for the `follow-link' event, the binding of that event determines
|
|
773 what to do.
|
59016
|
774
|
59500
|
775 The resulting value determine whether POS is inside a link:
|
|
776
|
|
777 - If the value is `mouse-face', POS is inside a link if there
|
59016
|
778 is a non-nil `mouse-face' property at POS. Return t in this case.
|
|
779
|
59500
|
780 - If the value is a function, FUNC, POS is inside a link if
|
59016
|
781 the call \(FUNC POS) returns non-nil. Return the return value
|
60204
|
782 from that call. Arg is \(posn-point POS) if POS is a mouse event,
|
59016
|
783
|
59500
|
784 - Otherwise, return the value itself.
|
59016
|
785
|
|
786 The return value is interpreted as follows:
|
|
787
|
|
788 - If it is a string, the mouse-1 event is translated into the
|
|
789 first character of the string, i.e. the action of the mouse-1
|
|
790 click is the local or global binding of that character.
|
|
791
|
|
792 - If it is a vector, the mouse-1 event is translated into the
|
|
793 first element of that vector, i.e. the action of the mouse-1
|
|
794 click is the local or global binding of that event.
|
|
795
|
|
796 - Otherwise, the mouse-1 event is translated into a mouse-2 event
|
|
797 at the same position."
|
60253
|
798 (let ((w (and (consp pos) (posn-window pos))))
|
|
799 (if (consp pos)
|
|
800 (setq pos (and (or mouse-1-click-in-non-selected-windows
|
|
801 (eq (selected-window) w))
|
|
802 (posn-point pos))))
|
|
803 (when pos
|
|
804 (with-current-buffer (window-buffer w)
|
|
805 (let ((action
|
|
806 (or (get-char-property pos 'follow-link)
|
|
807 (save-excursion
|
|
808 (goto-char pos)
|
|
809 (key-binding [follow-link] nil t)))))
|
|
810 (cond
|
|
811 ((eq action 'mouse-face)
|
|
812 (and (get-char-property pos 'mouse-face) t))
|
|
813 ((functionp action)
|
|
814 (funcall action pos))
|
|
815 (t action)))))))
|
60204
|
816
|
61160
|
817 (defun mouse-fixup-help-message (msg)
|
|
818 "Fix help message MSG for `mouse-1-click-follows-link'."
|
|
819 (let (mp pos)
|
|
820 (if (and mouse-1-click-follows-link
|
|
821 (stringp msg)
|
|
822 (save-match-data
|
|
823 (string-match "^mouse-2" msg))
|
|
824 (setq mp (mouse-pixel-position))
|
|
825 (consp (setq pos (cdr mp)))
|
|
826 (car pos) (>= (car pos) 0)
|
|
827 (cdr pos) (>= (cdr pos) 0)
|
|
828 (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
|
|
829 (windowp (posn-window pos)))
|
|
830 (with-current-buffer (window-buffer (posn-window pos))
|
|
831 (if (mouse-on-link-p pos)
|
|
832 (setq msg (concat
|
|
833 (cond
|
|
834 ((eq mouse-1-click-follows-link 'double) "double-")
|
|
835 ((and (integerp mouse-1-click-follows-link)
|
|
836 (< mouse-1-click-follows-link 0)) "Long ")
|
|
837 (t ""))
|
|
838 "mouse-1" (substring msg 7)))))))
|
|
839 msg)
|
59016
|
840
|
65640
|
841 (defun mouse-move-drag-overlay (ol start end mode)
|
|
842 (unless (= start end)
|
|
843 ;; Go to START first, so that when we move to END, if it's in the middle
|
|
844 ;; of intangible text, point jumps in the direction away from START.
|
|
845 ;; Don't do it if START=END otherwise a single click risks selecting
|
|
846 ;; a region if it's on intangible text. This exception was originally
|
|
847 ;; only applied on entry to mouse-drag-region, which had the problem
|
|
848 ;; that a tiny move during a single-click would cause the intangible
|
|
849 ;; text to be selected.
|
|
850 (goto-char start)
|
65651
|
851 (goto-char end)
|
|
852 (setq end (point)))
|
|
853 (let ((range (mouse-start-end start end mode)))
|
65640
|
854 (move-overlay ol (car range) (nth 1 range))))
|
|
855
|
67997
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
856 (defun mouse-drag-track (start-event &optional
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
857 do-mouse-drag-region-post-process)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
858 "Track mouse drags by highlighting area between point and cursor.
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
859 The region will be defined with mark and point, and the overlay
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
860 will be deleted after return. DO-MOUSE-DRAG-REGION-POST-PROCESS
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
861 should only be used by mouse-drag-region."
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
862 (mouse-minibuffer-check start-event)
|
65640
|
863 (setq mouse-selection-click-count-buffer (current-buffer))
|
|
864 (let* ((original-window (selected-window))
|
|
865 ;; We've recorded what we needed from the current buffer and
|
|
866 ;; window, now let's jump to the place of the event, where things
|
|
867 ;; are happening.
|
|
868 (_ (mouse-set-point start-event))
|
|
869 (echo-keystrokes 0)
|
14179
7db5b89b78b6
(mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
870 (start-posn (event-start start-event))
|
3928
|
871 (start-point (posn-point start-posn))
|
|
872 (start-window (posn-window start-posn))
|
41034
|
873 (start-window-start (window-start start-window))
|
28075
|
874 (start-hscroll (window-hscroll start-window))
|
3928
|
875 (bounds (window-edges start-window))
|
58194
|
876 (make-cursor-line-fully-visible nil)
|
3928
|
877 (top (nth 1 bounds))
|
|
878 (bottom (if (window-minibuffer-p start-window)
|
|
879 (nth 3 bounds)
|
|
880 ;; Don't count the mode line.
|
4738
|
881 (1- (nth 3 bounds))))
|
60204
|
882 (on-link (and mouse-1-click-follows-link
|
60253
|
883 (or mouse-1-click-in-non-selected-windows
|
65640
|
884 (eq start-window original-window))
|
|
885 ;; Use start-point before the intangibility
|
|
886 ;; treatment, in case we click on a link inside an
|
|
887 ;; intangible text.
|
|
888 (mouse-on-link-p start-point)))
|
|
889 (click-count (1- (event-click-count start-event)))
|
|
890 (remap-double-click (and on-link
|
|
891 (eq mouse-1-click-follows-link 'double)
|
|
892 (= click-count 1))))
|
4751
|
893 (setq mouse-selection-click-count click-count)
|
13038
|
894 ;; In case the down click is in the middle of some intangible text,
|
|
895 ;; use the end of that text, and put it in START-POINT.
|
|
896 (if (< (point) start-point)
|
|
897 (goto-char start-point))
|
|
898 (setq start-point (point))
|
65640
|
899 (if remap-double-click ;; Don't expand mouse overlay in links
|
59016
|
900 (setq click-count 0))
|
65640
|
901 (mouse-move-drag-overlay mouse-drag-overlay start-point start-point
|
|
902 click-count)
|
|
903 (overlay-put mouse-drag-overlay 'window start-window)
|
4200
|
904 (deactivate-mark)
|
65623
|
905 (let (event end end-point last-end-point)
|
3566
|
906 (track-mouse
|
3928
|
907 (while (progn
|
3961
|
908 (setq event (read-event))
|
65640
|
909 (or (mouse-movement-p event)
|
|
910 (memq (car-safe event) '(switch-frame select-window))))
|
|
911 (if (memq (car-safe event) '(switch-frame select-window))
|
3961
|
912 nil
|
|
913 (setq end (event-end event)
|
|
914 end-point (posn-point end))
|
16304
ba59fb4dd237
(mouse-drag-region): Ignore event end-point if it is not a number.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
915 (if (numberp end-point)
|
15642
|
916 (setq last-end-point end-point))
|
3961
|
917
|
|
918 (cond
|
|
919 ;; Are we moving within the original window?
|
|
920 ((and (eq (posn-window end) start-window)
|
|
921 (integer-or-marker-p end-point))
|
65640
|
922 (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
|
3961
|
923
|
6923
|
924 (t
|
|
925 (let ((mouse-row (cdr (cdr (mouse-position)))))
|
65640
|
926 (cond
|
|
927 ((null mouse-row))
|
|
928 ((< mouse-row top)
|
|
929 (mouse-scroll-subr start-window (- mouse-row top)
|
|
930 mouse-drag-overlay start-point))
|
|
931 ((>= mouse-row bottom)
|
|
932 (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
|
|
933 mouse-drag-overlay start-point)))))))))
|
41611
|
934
|
23611
|
935 ;; In case we did not get a mouse-motion event
|
|
936 ;; for the final move of the mouse before a drag event
|
|
937 ;; pretend that we did get one.
|
|
938 (when (and (memq 'drag (event-modifiers (car-safe event)))
|
65640
|
939 (setq end (event-end event)
|
23611
|
940 end-point (posn-point end))
|
|
941 (eq (posn-window end) start-window)
|
|
942 (integer-or-marker-p end-point))
|
65640
|
943 (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
|
23611
|
944
|
67997
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
945 ;; Handle the terminating event
|
7966
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
946 (if (consp event)
|
66085
|
947 (let* ((fun (key-binding (vector (car event))))
|
|
948 (do-multi-click (and (> (event-click-count event) 0)
|
|
949 (functionp fun)
|
67997
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
950 (not (memq fun
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
951 '(mouse-set-point
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
952 mouse-set-region))))))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
953 ;; Run the binding of the terminating up-event, if possible.
|
66085
|
954 (if (and (not (= (overlay-start mouse-drag-overlay)
|
|
955 (overlay-end mouse-drag-overlay)))
|
|
956 (not do-multi-click))
|
18459
|
957 (let* ((stop-point
|
|
958 (if (numberp (posn-point (event-end event)))
|
|
959 (posn-point (event-end event))
|
|
960 last-end-point))
|
|
961 ;; The end that comes from where we ended the drag.
|
|
962 ;; Point goes here.
|
|
963 (region-termination
|
67997
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
964 (if (and stop-point (< stop-point start-point))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
965 (overlay-start mouse-drag-overlay)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
966 (overlay-end mouse-drag-overlay)))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
967 ;; The end that comes from where we started the drag.
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
968 ;; Mark goes there.
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
969 (region-commencement
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
970 (- (+ (overlay-end mouse-drag-overlay)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
971 (overlay-start mouse-drag-overlay))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
972 region-termination))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
973 last-command this-command)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
974 (push-mark region-commencement t t)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
975 (goto-char region-termination)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
976 (if (not do-mouse-drag-region-post-process)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
977 ;; Skip all post-event handling, return immediately.
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
978 (delete-overlay mouse-drag-overlay)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
979 ;; Don't let copy-region-as-kill set deactivate-mark.
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
980 (when mouse-drag-copy-region
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
981 (let (deactivate-mark)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
982 (copy-region-as-kill (point) (mark t))))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
983 (let ((buffer (current-buffer)))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
984 (mouse-show-mark)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
985 ;; mouse-show-mark can call read-event,
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
986 ;; and that means the Emacs server could switch buffers
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
987 ;; under us. If that happened,
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
988 ;; avoid trying to use the region.
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
989 (and (mark t) mark-active
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
990 (eq buffer (current-buffer))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
991 (mouse-set-region-1)))))
|
66085
|
992 ;; Run the binding of the terminating up-event.
|
|
993 ;; If a multiple click is not bound to mouse-set-point,
|
|
994 ;; cancel the effects of mouse-move-drag-overlay to
|
|
995 ;; avoid producing wrong results.
|
|
996 (if do-multi-click (goto-char start-point))
|
65640
|
997 (delete-overlay mouse-drag-overlay)
|
|
998 (when (and (functionp fun)
|
67997
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
999 (= start-hscroll (window-hscroll start-window))
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1000 ;; Don't run the up-event handler if the
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1001 ;; window start changed in a redisplay after
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1002 ;; the mouse-set-point for the down-mouse
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1003 ;; event at the beginning of this function.
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1004 ;; When the window start has changed, the
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1005 ;; up-mouse event will contain a different
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1006 ;; position due to the new window contents,
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1007 ;; and point is set again.
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1008 (or end-point
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1009 (= (window-start start-window)
|
217b260efd66
(mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
diff
changeset
|
1010 start-window-start)))
|
67870
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1011 (when (and on-link
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1012 (or (not end-point) (= end-point start-point))
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1013 (consp event)
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1014 (or remap-double-click
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1015 (and
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1016 (not (eq mouse-1-click-follows-link 'double))
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1017 (= click-count 0)
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1018 (= (event-click-count event) 1)
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1019 (not (input-pending-p))
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1020 (or (not (integerp mouse-1-click-follows-link))
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1021 (let ((t0 (posn-timestamp (event-start start-event)))
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1022 (t1 (posn-timestamp (event-end event))))
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1023 (and (integerp t0) (integerp t1)
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1024 (if (> mouse-1-click-follows-link 0)
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1025 (<= (- t1 t0) mouse-1-click-follows-link)
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1026 (< (- t0 t1) mouse-1-click-follows-link))))))))
|
68734
|
1027 ;; If we rebind to mouse-2, reselect previous selected window,
|
67870
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1028 ;; so that the mouse-2 event runs in the same
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1029 ;; situation as if user had clicked it directly.
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1030 ;; Fixes the bug reported by juri@jurta.org on 2005-12-27.
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1031 (if (or (vectorp on-link) (stringp on-link))
|
60b2bb5ad00f
(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1032 (setq event (aref on-link 0))
|
68734
|
1033 (select-window original-window)
|
67965
|
1034 (setcar event 'mouse-2)
|
|
1035 ;; If this mouse click has never been done by
|
|
1036 ;; the user, it doesn't have the necessary
|
|
1037 ;; property to be interpreted correctly.
|
|
1038 (put 'mouse-2 'event-kind 'mouse-click)))
|
65640
|
1039 (push event unread-command-events))))
|
|
1040
|
|
1041 ;; Case where the end-event is not a cons cell (it's just a boring
|
|
1042 ;; char-key-press).
|
10720
|
1043 (delete-overlay mouse-drag-overlay)))))
|
4738
|
1044
|
|
1045 ;; Commands to handle xterm-style multiple clicks.
|
|
1046 (defun mouse-skip-word (dir)
|
|
1047 "Skip over word, over whitespace, or over identical punctuation.
|
|
1048 If DIR is positive skip forward; if negative, skip backward."
|
|
1049 (let* ((char (following-char))
|
|
1050 (syntax (char-to-string (char-syntax char))))
|
22852
|
1051 (cond ((string= syntax "w")
|
|
1052 ;; Here, we can't use skip-syntax-forward/backward because
|
|
1053 ;; they don't pay attention to word-separating-categories,
|
|
1054 ;; and thus they will skip over a true word boundary. So,
|
|
1055 ;; we simularte the original behaviour by using
|
|
1056 ;; forward-word.
|
|
1057 (if (< dir 0)
|
|
1058 (if (not (looking-at "\\<"))
|
|
1059 (forward-word -1))
|
|
1060 (if (or (looking-at "\\<") (not (looking-at "\\>")))
|
|
1061 (forward-word 1))))
|
|
1062 ((string= syntax " ")
|
13038
|
1063 (if (< dir 0)
|
|
1064 (skip-syntax-backward syntax)
|
|
1065 (skip-syntax-forward syntax)))
|
|
1066 ((string= syntax "_")
|
|
1067 (if (< dir 0)
|
|
1068 (skip-syntax-backward "w_")
|
|
1069 (skip-syntax-forward "w_")))
|
|
1070 ((< dir 0)
|
|
1071 (while (and (not (bobp)) (= (preceding-char) char))
|
|
1072 (forward-char -1)))
|
|
1073 (t
|
|
1074 (while (and (not (eobp)) (= (following-char) char))
|
|
1075 (forward-char 1))))))
|
3928
|
1076
|
4751
|
1077 (defun mouse-start-end (start end mode)
|
66669
|
1078 "Return a list of region bounds based on START and END according to MODE.
|
52405
|
1079 If MODE is 0 then set point to (min START END), mark to (max START END).
|
|
1080 If MODE is 1 then set point to start of word at (min START END),
|
|
1081 mark to end of word at (max START END).
|
|
1082 If MODE is 2 then do the same for lines."
|
4738
|
1083 (if (> start end)
|
|
1084 (let ((temp start))
|
|
1085 (setq start end
|
|
1086 end temp)))
|
5153
|
1087 (setq mode (mod mode 3))
|
4738
|
1088 (cond ((= mode 0)
|
|
1089 (list start end))
|
|
1090 ((and (= mode 1)
|
|
1091 (= start end)
|
5869
|
1092 (char-after start)
|
4738
|
1093 (= (char-syntax (char-after start)) ?\())
|
5879
|
1094 (list start
|
|
1095 (save-excursion
|
|
1096 (goto-char start)
|
|
1097 (forward-sexp 1)
|
|
1098 (point))))
|
4738
|
1099 ((and (= mode 1)
|
|
1100 (= start end)
|
5869
|
1101 (char-after start)
|
4738
|
1102 (= (char-syntax (char-after start)) ?\)))
|
40268
|
1103 (list (save-excursion
|
4738
|
1104 (goto-char (1+ start))
|
4788
|
1105 (backward-sexp 1)
|
|
1106 (point))
|
4738
|
1107 (1+ start)))
|
15561
|
1108 ((and (= mode 1)
|
|
1109 (= start end)
|
|
1110 (char-after start)
|
|
1111 (= (char-syntax (char-after start)) ?\"))
|
|
1112 (let ((open (or (eq start (point-min))
|
|
1113 (save-excursion
|
|
1114 (goto-char (- start 1))
|
|
1115 (looking-at "\\s(\\|\\s \\|\\s>")))))
|
|
1116 (if open
|
|
1117 (list start
|
|
1118 (save-excursion
|
|
1119 (condition-case nil
|
40268
|
1120 (progn
|
15561
|
1121 (goto-char start)
|
|
1122 (forward-sexp 1)
|
|
1123 (point))
|
|
1124 (error end))))
|
16746
|
1125 (list (save-excursion
|
15561
|
1126 (condition-case nil
|
|
1127 (progn
|
|
1128 (goto-char (1+ start))
|
|
1129 (backward-sexp 1)
|
|
1130 (point))
|
16746
|
1131 (error end)))
|
|
1132 (1+ start)))))
|
4738
|
1133 ((= mode 1)
|
|
1134 (list (save-excursion
|
|
1135 (goto-char start)
|
|
1136 (mouse-skip-word -1)
|
|
1137 (point))
|
|
1138 (save-excursion
|
|
1139 (goto-char end)
|
|
1140 (mouse-skip-word 1)
|
|
1141 (point))))
|
|
1142 ((= mode 2)
|
|
1143 (list (save-excursion
|
|
1144 (goto-char start)
|
|
1145 (beginning-of-line 1)
|
|
1146 (point))
|
|
1147 (save-excursion
|
|
1148 (goto-char end)
|
|
1149 (forward-line 1)
|
|
1150 (point))))))
|
3808
|
1151
|
3712
|
1152 ;; Subroutine: set the mark where CLICK happened,
|
|
1153 ;; but don't do anything else.
|
|
1154 (defun mouse-set-mark-fast (click)
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1155 (mouse-minibuffer-check click)
|
3712
|
1156 (let ((posn (event-start click)))
|
|
1157 (select-window (posn-window posn))
|
|
1158 (if (numberp (posn-point posn))
|
|
1159 (push-mark (posn-point posn) t t))))
|
|
1160
|
15613
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1161 (defun mouse-undouble-last-event (events)
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1162 (let* ((index (1- (length events)))
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1163 (last (nthcdr index events))
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1164 (event (car last))
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1165 (basic (event-basic-type event))
|
17983
|
1166 (old-modifiers (event-modifiers event))
|
|
1167 (modifiers (delq 'double (delq 'triple (copy-sequence old-modifiers))))
|
15613
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1168 (new
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1169 (if (consp event)
|
18503
|
1170 ;; Use reverse, not nreverse, since event-modifiers
|
|
1171 ;; does not copy the list it returns.
|
18689
|
1172 (cons (event-convert-list (reverse (cons basic modifiers)))
|
15613
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1173 (cdr event))
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1174 event)))
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1175 (setcar last new)
|
17983
|
1176 (if (and (not (equal modifiers old-modifiers))
|
|
1177 (key-binding (apply 'vector events)))
|
15613
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1178 t
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1179 (setcar last event)
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1180 nil)))
|
4c646bed64d0
(mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
diff
changeset
|
1181
|
40268
|
1182 ;; Momentarily show where the mark is, if highlighting doesn't show it.
|
15941
|
1183
|
66669
|
1184 (defcustom mouse-region-delete-keys '([delete] [deletechar] [backspace])
|
|
1185 "List of keys that should cause the mouse region to be deleted."
|
|
1186 :group 'mouse
|
|
1187 :type '(repeat key-sequence))
|
15941
|
1188
|
3712
|
1189 (defun mouse-show-mark ()
|
57749
|
1190 (let ((inhibit-quit t)
|
|
1191 (echo-keystrokes 0)
|
|
1192 event events key ignore
|
57780
|
1193 (x-lost-selection-functions
|
57785
|
1194 (when (boundp 'x-lost-selection-functions)
|
|
1195 (copy-sequence x-lost-selection-functions))))
|
|
1196 (add-hook 'x-lost-selection-functions
|
57749
|
1197 (lambda (seltype)
|
57785
|
1198 (when (eq seltype 'PRIMARY)
|
|
1199 (setq ignore t)
|
|
1200 (throw 'mouse-show-mark t))))
|
57749
|
1201 (if transient-mark-mode
|
|
1202 (delete-overlay mouse-drag-overlay)
|
|
1203 (move-overlay mouse-drag-overlay (point) (mark t)))
|
|
1204 (catch 'mouse-show-mark
|
|
1205 ;; In this loop, execute scroll bar and switch-frame events.
|
59470
f009f3970cd9
(mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1206 ;; Should we similarly handle `select-window' events? --Stef
|
57749
|
1207 ;; Also ignore down-events that are undefined.
|
|
1208 (while (progn (setq event (read-event))
|
|
1209 (setq events (append events (list event)))
|
|
1210 (setq key (apply 'vector events))
|
|
1211 (or (and (consp event)
|
|
1212 (eq (car event) 'switch-frame))
|
|
1213 (and (consp event)
|
|
1214 (eq (posn-point (event-end event))
|
|
1215 'vertical-scroll-bar))
|
|
1216 (and (memq 'down (event-modifiers event))
|
|
1217 (not (key-binding key))
|
|
1218 (not (mouse-undouble-last-event events))
|
|
1219 (not (member key mouse-region-delete-keys)))))
|
|
1220 (and (consp event)
|
|
1221 (or (eq (car event) 'switch-frame)
|
|
1222 (eq (posn-point (event-end event))
|
|
1223 'vertical-scroll-bar))
|
|
1224 (let ((keys (vector 'vertical-scroll-bar event)))
|
|
1225 (and (key-binding keys)
|
|
1226 (progn
|
|
1227 (call-interactively (key-binding keys)
|
|
1228 nil keys)
|
|
1229 (setq events nil)))))))
|
|
1230 ;; If we lost the selection, just turn off the highlighting.
|
57785
|
1231 (unless ignore
|
57749
|
1232 ;; For certain special keys, delete the region.
|
|
1233 (if (member key mouse-region-delete-keys)
|
57927
|
1234 (delete-region (mark t) (point))
|
57749
|
1235 ;; Otherwise, unread the key so it gets executed normally.
|
|
1236 (setq unread-command-events
|
|
1237 (nconc events unread-command-events))))
|
|
1238 (setq quit-flag nil)
|
|
1239 (unless transient-mark-mode
|
43732
|
1240 (delete-overlay mouse-drag-overlay))))
|
3712
|
1241
|
465
|
1242 (defun mouse-set-mark (click)
|
|
1243 "Set mark at the position clicked on with the mouse.
|
|
1244 Display cursor at that position for a second.
|
|
1245 This must be bound to a mouse click."
|
1113
|
1246 (interactive "e")
|
8534
|
1247 (mouse-minibuffer-check click)
|
|
1248 (select-window (posn-window (event-start click)))
|
|
1249 ;; We don't use save-excursion because that preserves the mark too.
|
66
|
1250 (let ((point-save (point)))
|
|
1251 (unwind-protect
|
465
|
1252 (progn (mouse-set-point click)
|
3119
|
1253 (push-mark nil t t)
|
|
1254 (or transient-mark-mode
|
|
1255 (sit-for 1)))
|
66
|
1256 (goto-char point-save))))
|
|
1257
|
465
|
1258 (defun mouse-kill (click)
|
|
1259 "Kill the region between point and the mouse click.
|
|
1260 The text is saved in the kill ring, as with \\[kill-region]."
|
1113
|
1261 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1262 (mouse-minibuffer-check click)
|
6301
|
1263 (let* ((posn (event-start click))
|
|
1264 (click-posn (posn-point posn)))
|
|
1265 (select-window (posn-window posn))
|
1039
|
1266 (if (numberp click-posn)
|
|
1267 (kill-region (min (point) click-posn)
|
|
1268 (max (point) click-posn)))))
|
66
|
1269
|
705
|
1270 (defun mouse-yank-at-click (click arg)
|
|
1271 "Insert the last stretch of killed text at the position clicked on.
|
28922
|
1272 Also move point to one end of the text thus inserted (normally the end),
|
42149
|
1273 and set mark at the beginning.
|
5799
|
1274 Prefix arguments are interpreted as with \\[yank].
|
|
1275 If `mouse-yank-at-point' is non-nil, insert at point
|
|
1276 regardless of where you click."
|
57843
|
1277 (interactive "e\nP")
|
10258
|
1278 ;; Give temporary modes such as isearch a chance to turn off.
|
|
1279 (run-hooks 'mouse-leave-buffer-hook)
|
5799
|
1280 (or mouse-yank-at-point (mouse-set-point click))
|
4788
|
1281 (setq this-command 'yank)
|
12357
|
1282 (setq mouse-selection-click-count 0)
|
705
|
1283 (yank arg))
|
|
1284
|
|
1285 (defun mouse-kill-ring-save (click)
|
465
|
1286 "Copy the region between point and the mouse click in the kill ring.
|
|
1287 This does not delete the region; it acts like \\[kill-ring-save]."
|
1113
|
1288 (interactive "e")
|
3712
|
1289 (mouse-set-mark-fast click)
|
8135
|
1290 (let (this-command last-command)
|
|
1291 (kill-ring-save (point) (mark t)))
|
3712
|
1292 (mouse-show-mark))
|
66
|
1293
|
1821
|
1294 ;;; This function used to delete the text between point and the mouse
|
|
1295 ;;; whenever it was equal to the front of the kill ring, but some
|
|
1296 ;;; people found that confusing.
|
|
1297
|
|
1298 ;;; A list (TEXT START END), describing the text and position of the last
|
|
1299 ;;; invocation of mouse-save-then-kill.
|
|
1300 (defvar mouse-save-then-kill-posn nil)
|
|
1301
|
5007
|
1302 (defun mouse-save-then-kill-delete-region (beg end)
|
5153
|
1303 ;; We must make our own undo boundaries
|
|
1304 ;; because they happen automatically only for the current buffer.
|
|
1305 (undo-boundary)
|
5027
|
1306 (if (or (= beg end) (eq buffer-undo-list t))
|
|
1307 ;; If we have no undo list in this buffer,
|
|
1308 ;; just delete.
|
|
1309 (delete-region beg end)
|
|
1310 ;; Delete, but make the undo-list entry share with the kill ring.
|
|
1311 ;; First, delete just one char, so in case buffer is being modified
|
|
1312 ;; for the first time, the undo list records that fact.
|
29344
|
1313 (let (before-change-functions after-change-functions)
|
7866
|
1314 (delete-region beg
|
|
1315 (+ beg (if (> end beg) 1 -1))))
|
5027
|
1316 (let ((buffer-undo-list buffer-undo-list))
|
|
1317 ;; Undo that deletion--but don't change the undo list!
|
29344
|
1318 (let (before-change-functions after-change-functions)
|
7866
|
1319 (primitive-undo 1 buffer-undo-list))
|
5027
|
1320 ;; Now delete the rest of the specified region,
|
|
1321 ;; but don't record it.
|
|
1322 (setq buffer-undo-list t)
|
5153
|
1323 (if (/= (length (car kill-ring)) (- (max end beg) (min end beg)))
|
|
1324 (error "Lossage in mouse-save-then-kill-delete-region"))
|
5027
|
1325 (delete-region beg end))
|
|
1326 (let ((tail buffer-undo-list))
|
|
1327 ;; Search back in buffer-undo-list for the string
|
|
1328 ;; that came from deleting one character.
|
|
1329 (while (and tail (not (stringp (car (car tail)))))
|
|
1330 (setq tail (cdr tail)))
|
|
1331 ;; Replace it with an entry for the entire deleted text.
|
|
1332 (and tail
|
5153
|
1333 (setcar tail (cons (car kill-ring) (min beg end))))))
|
|
1334 (undo-boundary))
|
4751
|
1335
|
1214
|
1336 (defun mouse-save-then-kill (click)
|
1765
|
1337 "Save text to point in kill ring; the second time, kill the text.
|
|
1338 If the text between point and the mouse is the same as what's
|
|
1339 at the front of the kill ring, this deletes the text.
|
|
1340 Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
|
4751
|
1341 which prepares for a second click to delete the text.
|
|
1342
|
|
1343 If you have selected words or lines, this command extends the
|
|
1344 selection through the word or line clicked on. If you do this
|
|
1345 again in a different position, it extends the selection again.
|
40268
|
1346 If you do this twice in the same position, the selection is killed."
|
1214
|
1347 (interactive "e")
|
21426
|
1348 (let ((before-scroll
|
|
1349 (with-current-buffer (window-buffer (posn-window (event-start click)))
|
|
1350 point-before-scroll)))
|
10556
|
1351 (mouse-minibuffer-check click)
|
|
1352 (let ((click-posn (posn-point (event-start click)))
|
|
1353 ;; Don't let a subsequent kill command append to this one:
|
|
1354 ;; prevent setting this-command to kill-region.
|
|
1355 (this-command this-command))
|
65640
|
1356 (if (and (with-current-buffer
|
|
1357 (window-buffer (posn-window (event-start click)))
|
12436
|
1358 (and (mark t) (> (mod mouse-selection-click-count 3) 0)
|
|
1359 ;; Don't be fooled by a recent click in some other buffer.
|
40268
|
1360 (eq mouse-selection-click-count-buffer
|
12436
|
1361 (current-buffer)))))
|
10556
|
1362 (if (not (and (eq last-command 'mouse-save-then-kill)
|
|
1363 (equal click-posn
|
|
1364 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
|
|
1365 ;; Find both ends of the object selected by this click.
|
|
1366 (let* ((range
|
|
1367 (mouse-start-end click-posn click-posn
|
|
1368 mouse-selection-click-count)))
|
|
1369 ;; Move whichever end is closer to the click.
|
|
1370 ;; That's what xterm does, and it seems reasonable.
|
|
1371 (if (< (abs (- click-posn (mark t)))
|
|
1372 (abs (- click-posn (point))))
|
|
1373 (set-mark (car range))
|
|
1374 (goto-char (nth 1 range)))
|
|
1375 ;; We have already put the old region in the kill ring.
|
|
1376 ;; Replace it with the extended region.
|
|
1377 ;; (It would be annoying to make a separate entry.)
|
|
1378 (kill-new (buffer-substring (point) (mark t)) t)
|
10720
|
1379 (mouse-set-region-1)
|
10556
|
1380 ;; Arrange for a repeated mouse-3 to kill this region.
|
|
1381 (setq mouse-save-then-kill-posn
|
|
1382 (list (car kill-ring) (point) click-posn))
|
|
1383 (mouse-show-mark))
|
|
1384 ;; If we click this button again without moving it,
|
|
1385 ;; that time kill.
|
11818
|
1386 (mouse-save-then-kill-delete-region (mark) (point))
|
10556
|
1387 (setq mouse-selection-click-count 0)
|
5027
|
1388 (setq mouse-save-then-kill-posn nil))
|
10556
|
1389 (if (and (eq last-command 'mouse-save-then-kill)
|
|
1390 mouse-save-then-kill-posn
|
|
1391 (eq (car mouse-save-then-kill-posn) (car kill-ring))
|
|
1392 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
|
|
1393 ;; If this is the second time we've called
|
|
1394 ;; mouse-save-then-kill, delete the text from the buffer.
|
|
1395 (progn
|
|
1396 (mouse-save-then-kill-delete-region (point) (mark))
|
|
1397 ;; After we kill, another click counts as "the first time".
|
|
1398 (setq mouse-save-then-kill-posn nil))
|
15321
1aeaf1224f0b
(mouse-show-mark): Use temporary highlighting if possible instead of a pause.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1399 ;; This is not a repetition.
|
1aeaf1224f0b
(mouse-show-mark): Use temporary highlighting if possible instead of a pause.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1400 ;; We are adjusting an old selection or creating a new one.
|
10556
|
1401 (if (or (and (eq last-command 'mouse-save-then-kill)
|
|
1402 mouse-save-then-kill-posn)
|
|
1403 (and mark-active transient-mark-mode)
|
|
1404 (and (memq last-command
|
|
1405 '(mouse-drag-region mouse-set-region))
|
|
1406 (or mark-even-if-inactive
|
|
1407 (not transient-mark-mode))))
|
|
1408 ;; We have a selection or suitable region, so adjust it.
|
|
1409 (let* ((posn (event-start click))
|
|
1410 (new (posn-point posn)))
|
|
1411 (select-window (posn-window posn))
|
|
1412 (if (numberp new)
|
|
1413 (progn
|
|
1414 ;; Move whichever end of the region is closer to the click.
|
|
1415 ;; That is what xterm does, and it seems reasonable.
|
36134
|
1416 (if (<= (abs (- new (point))) (abs (- new (mark t))))
|
10556
|
1417 (goto-char new)
|
|
1418 (set-mark new))
|
|
1419 (setq deactivate-mark nil)))
|
65640
|
1420 (kill-new (buffer-substring (point) (mark t)) t))
|
10556
|
1421 ;; Set the mark where point is, then move where clicked.
|
|
1422 (mouse-set-mark-fast click)
|
|
1423 (if before-scroll
|
|
1424 (goto-char before-scroll))
|
65640
|
1425 (exchange-point-and-mark) ;Why??? --Stef
|
|
1426 (kill-new (buffer-substring (point) (mark t))))
|
|
1427 (mouse-show-mark)
|
10720
|
1428 (mouse-set-region-1)
|
10556
|
1429 (setq mouse-save-then-kill-posn
|
|
1430 (list (car kill-ring) (point) click-posn)))))))
|
3808
|
1431
|
|
1432 (global-set-key [M-mouse-1] 'mouse-start-secondary)
|
|
1433 (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
|
|
1434 (global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
|
|
1435 (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
|
5153
|
1436 (global-set-key [M-mouse-2] 'mouse-yank-secondary)
|
1214
|
1437
|
65640
|
1438 (defconst mouse-secondary-overlay
|
|
1439 (let ((ol (make-overlay (point-min) (point-min))))
|
|
1440 (delete-overlay ol)
|
|
1441 (overlay-put ol 'face 'secondary-selection)
|
|
1442 ol)
|
|
1443 "An overlay which records the current secondary selection.
|
|
1444 It is deleted when there is no secondary selection.")
|
3808
|
1445
|
9206
|
1446 (defvar mouse-secondary-click-count 0)
|
|
1447
|
3808
|
1448 ;; A marker which records the specified first end for a secondary selection.
|
|
1449 ;; May be nil.
|
|
1450 (defvar mouse-secondary-start nil)
|
|
1451
|
|
1452 (defun mouse-start-secondary (click)
|
|
1453 "Set one end of the secondary selection to the position clicked on.
|
|
1454 Use \\[mouse-secondary-save-then-kill] to set the other end
|
|
1455 and complete the secondary selection."
|
|
1456 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1457 (mouse-minibuffer-check click)
|
3808
|
1458 (let ((posn (event-start click)))
|
65640
|
1459 (with-current-buffer (window-buffer (posn-window posn))
|
3823
|
1460 ;; Cancel any preexisting secondary selection.
|
65640
|
1461 (delete-overlay mouse-secondary-overlay)
|
3823
|
1462 (if (numberp (posn-point posn))
|
|
1463 (progn
|
|
1464 (or mouse-secondary-start
|
|
1465 (setq mouse-secondary-start (make-marker)))
|
|
1466 (move-marker mouse-secondary-start (posn-point posn)))))))
|
3808
|
1467
|
|
1468 (defun mouse-set-secondary (click)
|
|
1469 "Set the secondary selection to the text that the mouse is dragged over.
|
|
1470 This must be bound to a mouse drag event."
|
|
1471 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1472 (mouse-minibuffer-check click)
|
3808
|
1473 (let ((posn (event-start click))
|
|
1474 beg
|
|
1475 (end (event-end click)))
|
65640
|
1476 (with-current-buffer (window-buffer (posn-window posn))
|
3823
|
1477 (if (numberp (posn-point posn))
|
|
1478 (setq beg (posn-point posn)))
|
65640
|
1479 (move-overlay mouse-secondary-overlay beg (posn-point end)))))
|
3808
|
1480
|
4788
|
1481 (defun mouse-drag-secondary (start-event)
|
3808
|
1482 "Set the secondary selection to the text that the mouse is dragged over.
|
4788
|
1483 Highlight the drag area as you move the mouse.
|
16318
|
1484 This must be bound to a button-down mouse event.
|
|
1485 The function returns a non-nil value if it creates a secondary selection."
|
3808
|
1486 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1487 (mouse-minibuffer-check start-event)
|
14179
7db5b89b78b6
(mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1488 (let* ((echo-keystrokes 0)
|
7db5b89b78b6
(mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1489 (start-posn (event-start start-event))
|
4788
|
1490 (start-point (posn-point start-posn))
|
|
1491 (start-window (posn-window start-posn))
|
|
1492 (bounds (window-edges start-window))
|
|
1493 (top (nth 1 bounds))
|
|
1494 (bottom (if (window-minibuffer-p start-window)
|
|
1495 (nth 3 bounds)
|
|
1496 ;; Don't count the mode line.
|
|
1497 (1- (nth 3 bounds))))
|
|
1498 (click-count (1- (event-click-count start-event))))
|
65640
|
1499 (with-current-buffer (window-buffer start-window)
|
9206
|
1500 (setq mouse-secondary-click-count click-count)
|
5153
|
1501 (if (> (mod click-count 3) 0)
|
5007
|
1502 ;; Double or triple press: make an initial selection
|
|
1503 ;; of one word or line.
|
4788
|
1504 (let ((range (mouse-start-end start-point start-point click-count)))
|
|
1505 (set-marker mouse-secondary-start nil)
|
65640
|
1506 ;; Why the double move? --Stef
|
|
1507 ;; (move-overlay mouse-secondary-overlay 1 1
|
|
1508 ;; (window-buffer start-window))
|
4788
|
1509 (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
|
|
1510 (window-buffer start-window)))
|
5007
|
1511 ;; Single-press: cancel any preexisting secondary selection.
|
4788
|
1512 (or mouse-secondary-start
|
|
1513 (setq mouse-secondary-start (make-marker)))
|
|
1514 (set-marker mouse-secondary-start start-point)
|
|
1515 (delete-overlay mouse-secondary-overlay))
|
|
1516 (let (event end end-point)
|
|
1517 (track-mouse
|
|
1518 (while (progn
|
|
1519 (setq event (read-event))
|
|
1520 (or (mouse-movement-p event)
|
59470
f009f3970cd9
(mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1521 (memq (car-safe event) '(switch-frame select-window))))
|
4788
|
1522
|
59470
f009f3970cd9
(mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1523 (if (memq (car-safe event) '(switch-frame select-window))
|
4788
|
1524 nil
|
|
1525 (setq end (event-end event)
|
|
1526 end-point (posn-point end))
|
|
1527 (cond
|
|
1528 ;; Are we moving within the original window?
|
|
1529 ((and (eq (posn-window end) start-window)
|
|
1530 (integer-or-marker-p end-point))
|
|
1531 (let ((range (mouse-start-end start-point end-point
|
|
1532 click-count)))
|
8224
|
1533 (if (or (/= start-point end-point)
|
|
1534 (null (marker-position mouse-secondary-start)))
|
|
1535 (progn
|
|
1536 (set-marker mouse-secondary-start nil)
|
|
1537 (move-overlay mouse-secondary-overlay
|
|
1538 (car range) (nth 1 range))))))
|
7588
|
1539 (t
|
|
1540 (let ((mouse-row (cdr (cdr (mouse-position)))))
|
|
1541 (cond
|
|
1542 ((null mouse-row))
|
|
1543 ((< mouse-row top)
|
7932
|
1544 (mouse-scroll-subr start-window (- mouse-row top)
|
|
1545 mouse-secondary-overlay start-point))
|
8064
|
1546 ((>= mouse-row bottom)
|
7932
|
1547 (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
|
7588
|
1548 mouse-secondary-overlay start-point)))))))))
|
4788
|
1549
|
7966
76118755a179
(mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1550 (if (consp event)
|
4788
|
1551 (if (marker-position mouse-secondary-start)
|
|
1552 (save-window-excursion
|
|
1553 (delete-overlay mouse-secondary-overlay)
|
5153
|
1554 (x-set-selection 'SECONDARY nil)
|
4788
|
1555 (select-window start-window)
|
|
1556 (save-excursion
|
|
1557 (goto-char mouse-secondary-start)
|
16318
|
1558 (sit-for 1)
|
|
1559 nil))
|
5153
|
1560 (x-set-selection
|
|
1561 'SECONDARY
|
|
1562 (buffer-substring (overlay-start mouse-secondary-overlay)
|
|
1563 (overlay-end mouse-secondary-overlay)))))))))
|
|
1564
|
|
1565 (defun mouse-yank-secondary (click)
|
5799
|
1566 "Insert the secondary selection at the position clicked on.
|
|
1567 Move point to the end of the inserted text.
|
|
1568 If `mouse-yank-at-point' is non-nil, insert at point
|
|
1569 regardless of where you click."
|
57843
|
1570 (interactive "e")
|
10258
|
1571 ;; Give temporary modes such as isearch a chance to turn off.
|
|
1572 (run-hooks 'mouse-leave-buffer-hook)
|
5799
|
1573 (or mouse-yank-at-point (mouse-set-point click))
|
|
1574 (insert (x-get-selection 'SECONDARY)))
|
3808
|
1575
|
5280
|
1576 (defun mouse-kill-secondary ()
|
5153
|
1577 "Kill the text in the secondary selection.
|
|
1578 This is intended more as a keyboard command than as a mouse command
|
|
1579 but it can work as either one.
|
|
1580
|
|
1581 The current buffer (in case of keyboard use), or the buffer clicked on,
|
|
1582 must be the one that the secondary selection is in. This requirement
|
|
1583 is to prevent accidents."
|
5280
|
1584 (interactive)
|
|
1585 (let* ((keys (this-command-keys))
|
|
1586 (click (elt keys (1- (length keys)))))
|
|
1587 (or (eq (overlay-buffer mouse-secondary-overlay)
|
|
1588 (if (listp click)
|
|
1589 (window-buffer (posn-window (event-start click)))
|
|
1590 (current-buffer)))
|
|
1591 (error "Select or click on the buffer where the secondary selection is")))
|
10838
|
1592 (let (this-command)
|
65640
|
1593 (with-current-buffer (overlay-buffer mouse-secondary-overlay)
|
10838
|
1594 (kill-region (overlay-start mouse-secondary-overlay)
|
|
1595 (overlay-end mouse-secondary-overlay))))
|
3808
|
1596 (delete-overlay mouse-secondary-overlay)
|
10838
|
1597 ;;; (x-set-selection 'SECONDARY nil)
|
65640
|
1598 )
|
3808
|
1599
|
|
1600 (defun mouse-secondary-save-then-kill (click)
|
4788
|
1601 "Save text to point in kill ring; the second time, kill the text.
|
7302
|
1602 You must use this in a buffer where you have recently done \\[mouse-start-secondary].
|
|
1603 If the text between where you did \\[mouse-start-secondary] and where
|
|
1604 you use this command matches the text at the front of the kill ring,
|
|
1605 this command deletes the text.
|
3808
|
1606 Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
|
7302
|
1607 which prepares for a second click with this command to delete the text.
|
4788
|
1608
|
7302
|
1609 If you have already made a secondary selection in that buffer,
|
|
1610 this command extends or retracts the selection to where you click.
|
|
1611 If you do this again in a different position, it extends or retracts
|
|
1612 again. If you do this twice in the same position, it kills the selection."
|
3808
|
1613 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1614 (mouse-minibuffer-check click)
|
4788
|
1615 (let ((posn (event-start click))
|
|
1616 (click-posn (posn-point (event-start click)))
|
3808
|
1617 ;; Don't let a subsequent kill command append to this one:
|
|
1618 ;; prevent setting this-command to kill-region.
|
|
1619 (this-command this-command))
|
5153
|
1620 (or (eq (window-buffer (posn-window posn))
|
65640
|
1621 (or (overlay-buffer mouse-secondary-overlay)
|
5153
|
1622 (if mouse-secondary-start
|
|
1623 (marker-buffer mouse-secondary-start))))
|
|
1624 (error "Wrong buffer"))
|
65640
|
1625 (with-current-buffer (window-buffer (posn-window posn))
|
9206
|
1626 (if (> (mod mouse-secondary-click-count 3) 0)
|
5153
|
1627 (if (not (and (eq last-command 'mouse-secondary-save-then-kill)
|
|
1628 (equal click-posn
|
|
1629 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
|
|
1630 ;; Find both ends of the object selected by this click.
|
|
1631 (let* ((range
|
|
1632 (mouse-start-end click-posn click-posn
|
9206
|
1633 mouse-secondary-click-count)))
|
5153
|
1634 ;; Move whichever end is closer to the click.
|
|
1635 ;; That's what xterm does, and it seems reasonable.
|
|
1636 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
|
|
1637 (abs (- click-posn (overlay-end mouse-secondary-overlay))))
|
|
1638 (move-overlay mouse-secondary-overlay (car range)
|
|
1639 (overlay-end mouse-secondary-overlay))
|
4788
|
1640 (move-overlay mouse-secondary-overlay
|
|
1641 (overlay-start mouse-secondary-overlay)
|
|
1642 (nth 1 range)))
|
5153
|
1643 ;; We have already put the old region in the kill ring.
|
|
1644 ;; Replace it with the extended region.
|
|
1645 ;; (It would be annoying to make a separate entry.)
|
8765
77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1646 (kill-new (buffer-substring
|
77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1647 (overlay-start mouse-secondary-overlay)
|
77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1648 (overlay-end mouse-secondary-overlay)) t)
|
5153
|
1649 ;; Arrange for a repeated mouse-3 to kill this region.
|
|
1650 (setq mouse-save-then-kill-posn
|
|
1651 (list (car kill-ring) (point) click-posn)))
|
|
1652 ;; If we click this button again without moving it,
|
|
1653 ;; that time kill.
|
4788
|
1654 (progn
|
5153
|
1655 (mouse-save-then-kill-delete-region
|
|
1656 (overlay-start mouse-secondary-overlay)
|
|
1657 (overlay-end mouse-secondary-overlay))
|
|
1658 (setq mouse-save-then-kill-posn nil)
|
9206
|
1659 (setq mouse-secondary-click-count 0)
|
5153
|
1660 (delete-overlay mouse-secondary-overlay)))
|
|
1661 (if (and (eq last-command 'mouse-secondary-save-then-kill)
|
|
1662 mouse-save-then-kill-posn
|
|
1663 (eq (car mouse-save-then-kill-posn) (car kill-ring))
|
|
1664 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
|
|
1665 ;; If this is the second time we've called
|
|
1666 ;; mouse-secondary-save-then-kill, delete the text from the buffer.
|
|
1667 (progn
|
|
1668 (mouse-save-then-kill-delete-region
|
|
1669 (overlay-start mouse-secondary-overlay)
|
|
1670 (overlay-end mouse-secondary-overlay))
|
|
1671 (setq mouse-save-then-kill-posn nil)
|
|
1672 (delete-overlay mouse-secondary-overlay))
|
|
1673 (if (overlay-start mouse-secondary-overlay)
|
|
1674 ;; We have a selection, so adjust it.
|
|
1675 (progn
|
|
1676 (if (numberp click-posn)
|
|
1677 (progn
|
|
1678 ;; Move whichever end of the region is closer to the click.
|
|
1679 ;; That is what xterm does, and it seems reasonable.
|
|
1680 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
|
|
1681 (abs (- click-posn (overlay-end mouse-secondary-overlay))))
|
|
1682 (move-overlay mouse-secondary-overlay click-posn
|
|
1683 (overlay-end mouse-secondary-overlay))
|
4788
|
1684 (move-overlay mouse-secondary-overlay
|
|
1685 (overlay-start mouse-secondary-overlay)
|
|
1686 click-posn))
|
5153
|
1687 (setq deactivate-mark nil)))
|
8224
|
1688 (if (eq last-command 'mouse-secondary-save-then-kill)
|
40268
|
1689 ;; If the front of the kill ring comes from
|
8765
77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1690 ;; an immediately previous use of this command,
|
77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1691 ;; replace it with the extended region.
|
77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1692 ;; (It would be annoying to make a separate entry.)
|
77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1693 (kill-new (buffer-substring
|
8224
|
1694 (overlay-start mouse-secondary-overlay)
|
8765
77933f36ddc2
(mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1695 (overlay-end mouse-secondary-overlay)) t)
|
21194
|
1696 (let (deactivate-mark)
|
|
1697 (copy-region-as-kill (overlay-start mouse-secondary-overlay)
|
|
1698 (overlay-end mouse-secondary-overlay)))))
|
5153
|
1699 (if mouse-secondary-start
|
|
1700 ;; All we have is one end of a selection,
|
|
1701 ;; so put the other end here.
|
|
1702 (let ((start (+ 0 mouse-secondary-start)))
|
|
1703 (kill-ring-save start click-posn)
|
65640
|
1704 (move-overlay mouse-secondary-overlay start click-posn))))
|
5153
|
1705 (setq mouse-save-then-kill-posn
|
|
1706 (list (car kill-ring) (point) click-posn))))
|
10782
|
1707 (if (overlay-buffer mouse-secondary-overlay)
|
|
1708 (x-set-selection 'SECONDARY
|
5153
|
1709 (buffer-substring
|
|
1710 (overlay-start mouse-secondary-overlay)
|
|
1711 (overlay-end mouse-secondary-overlay)))))))
|
3808
|
1712
|
21148
bbbd345f54de
(mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1713 (defcustom mouse-buffer-menu-maxlen 20
|
13872
|
1714 "*Number of buffers in one pane (submenu) of the buffer menu.
|
|
1715 If we have lots of buffers, divide them into groups of
|
21148
bbbd345f54de
(mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1716 `mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one."
|
17636
|
1717 :type 'integer
|
|
1718 :group 'mouse)
|
13872
|
1719
|
21685
|
1720 (defcustom mouse-buffer-menu-mode-mult 4
|
|
1721 "*Group the buffers by the major mode groups on \\[mouse-buffer-menu]?
|
|
1722 This number which determines (in a hairy way) whether \\[mouse-buffer-menu]
|
|
1723 will split the buffer menu by the major modes (see
|
|
1724 `mouse-buffer-menu-mode-groups') or just by menu length.
|
|
1725 Set to 1 (or even 0!) if you want to group by major mode always, and to
|
|
1726 a large number if you prefer a mixed multitude. The default is 4."
|
|
1727 :type 'integer
|
|
1728 :group 'mouse
|
|
1729 :version "20.3")
|
|
1730
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1731 (defvar mouse-buffer-menu-mode-groups
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1732 '(("Info\\|Help\\|Apropos\\|Man" . "Help")
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1733 ("\\bVM\\b\\|\\bMH\\b\\|Message\\|Mail\\|Group\\|Score\\|Summary\\|Article"
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1734 . "Mail/News")
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1735 ("\\<C\\>" . "C")
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1736 ("ObjC" . "C")
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1737 ("Text" . "Text")
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1738 ("Outline" . "Text")
|
40379
|
1739 ("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML")
|
|
1740 ("log\\|diff\\|vc\\|cvs" . "Version Control") ; "Change Management"?
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1741 ("Lisp" . "Lisp"))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1742 "How to group various major modes together in \\[mouse-buffer-menu].
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1743 Each element has the form (REGEXP . GROUPNAME).
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1744 If the major mode's name string matches REGEXP, use GROUPNAME instead.")
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1745
|
1056
|
1746 (defun mouse-buffer-menu (event)
|
1728
|
1747 "Pop up a menu of buffers for selection with the mouse.
|
|
1748 This switches buffers in the window that you clicked on,
|
|
1749 and selects that window."
|
1113
|
1750 (interactive "e")
|
6266
66c0ed95c03f
(mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
1751 (mouse-minibuffer-check event)
|
21685
|
1752 (let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares)
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1753 ;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1754 (let ((tail buffers))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1755 (while tail
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1756 ;; Divide all buffers into buckets for various major modes.
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1757 ;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1758 (with-current-buffer (car tail)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1759 (let* ((adjusted-major-mode major-mode) elt)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1760 (let ((tail mouse-buffer-menu-mode-groups))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1761 (while tail
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1762 (if (string-match (car (car tail)) mode-name)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1763 (setq adjusted-major-mode (cdr (car tail))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1764 (setq tail (cdr tail))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1765 (setq elt (assoc adjusted-major-mode split-by-major-mode))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1766 (if (null elt)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1767 (setq elt (list adjusted-major-mode
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1768 (if (stringp adjusted-major-mode)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1769 adjusted-major-mode
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1770 mode-name))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1771 split-by-major-mode (cons elt split-by-major-mode)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1772 (or (memq (car tail) (cdr (cdr elt)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1773 (setcdr (cdr elt) (cons (car tail) (cdr (cdr elt)))))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1774 (setq tail (cdr tail))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1775 ;; Compute the sum of squares of sizes of the major-mode buckets.
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1776 (let ((tail split-by-major-mode))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1777 (setq sum-of-squares 0)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1778 (while tail
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1779 (setq sum-of-squares
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1780 (+ sum-of-squares
|
21685
|
1781 (let ((len (length (cdr (cdr (car tail)))))) (* len len))))
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1782 (setq tail (cdr tail))))
|
21685
|
1783 (if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
|
|
1784 (* (length buffers) (length buffers)))
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1785 ;; Subdividing by major modes really helps, so let's do it.
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1786 (let (subdivided-menus (buffers-left (length buffers)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1787 ;; Sort the list to put the most popular major modes first.
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1788 (setq split-by-major-mode
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1789 (sort split-by-major-mode
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1790 (function (lambda (elt1 elt2)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1791 (> (length elt1) (length elt2))))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1792 ;; Make a separate submenu for each major mode
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1793 ;; that has more than one buffer,
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1794 ;; unless all the remaining buffers are less than 1/10 of them.
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1795 (while (and split-by-major-mode
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1796 (and (> (length (car split-by-major-mode)) 3)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1797 (> (* buffers-left 10) (length buffers))))
|
38982
|
1798 (let ((this-mode-list (mouse-buffer-menu-alist
|
|
1799 (cdr (cdr (car split-by-major-mode))))))
|
|
1800 (and this-mode-list
|
|
1801 (setq subdivided-menus
|
|
1802 (cons (cons
|
|
1803 (nth 1 (car split-by-major-mode))
|
|
1804 this-mode-list)
|
|
1805 subdivided-menus))))
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1806 (setq buffers-left
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1807 (- buffers-left (length (cdr (car split-by-major-mode)))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1808 (setq split-by-major-mode (cdr split-by-major-mode)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1809 ;; If any major modes are left over,
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1810 ;; make a single submenu for them.
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1811 (if split-by-major-mode
|
38982
|
1812 (let ((others-list
|
|
1813 (mouse-buffer-menu-alist
|
|
1814 ;; we don't need split-by-major-mode any more,
|
|
1815 ;; so we can ditch it with nconc.
|
|
1816 (apply 'nconc (mapcar 'cddr split-by-major-mode)))))
|
|
1817 (and others-list
|
|
1818 (setq subdivided-menus
|
|
1819 (cons (cons "Others" others-list)
|
|
1820 subdivided-menus)))))
|
21685
|
1821 (setq menu (cons "Buffer Menu" (nreverse subdivided-menus))))
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1822 (progn
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1823 (setq alist (mouse-buffer-menu-alist buffers))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1824 (setq menu (cons "Buffer Menu"
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1825 (mouse-buffer-menu-split "Select Buffer" alist)))))
|
1728
|
1826 (let ((buf (x-popup-menu event menu))
|
|
1827 (window (posn-window (event-start event))))
|
21685
|
1828 (when buf
|
41033
|
1829 (select-window
|
|
1830 (if (framep window) (frame-selected-window window)
|
|
1831 window))
|
21685
|
1832 (switch-to-buffer buf)))))
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1833
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1834 (defun mouse-buffer-menu-alist (buffers)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1835 (let (tail
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1836 (maxlen 0)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1837 head)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1838 (setq buffers
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1839 (sort buffers
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1840 (function (lambda (elt1 elt2)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1841 (string< (buffer-name elt1) (buffer-name elt2))))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1842 (setq tail buffers)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1843 (while tail
|
63849
91ca3ff1b216
(mouse-buffer-menu-alist): Change space constants followed by a sexp to "?\s ".
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1844 (or (eq ?\s (aref (buffer-name (car tail)) 0))
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1845 (setq maxlen
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1846 (max maxlen
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1847 (length (buffer-name (car tail))))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1848 (setq tail (cdr tail)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1849 (setq tail buffers)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1850 (while tail
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1851 (let ((elt (car tail)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1852 (if (/= (aref (buffer-name elt) 0) ?\ )
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1853 (setq head
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1854 (cons
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1855 (cons
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1856 (format
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1857 (format "%%%ds %%s%%s %%s" maxlen)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1858 (buffer-name elt)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1859 (if (buffer-modified-p elt) "*" " ")
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1860 (save-excursion
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1861 (set-buffer elt)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1862 (if buffer-read-only "%" " "))
|
40268
|
1863 (or (buffer-file-name elt)
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1864 (save-excursion
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1865 (set-buffer elt)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1866 (if list-buffers-directory
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1867 (expand-file-name
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1868 list-buffers-directory)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1869 ""))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1870 elt)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1871 head))))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1872 (setq tail (cdr tail)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1873 ;; Compensate for the reversal that the above loop does.
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1874 (nreverse head)))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1875
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1876 (defun mouse-buffer-menu-split (title alist)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1877 ;; If we have lots of buffers, divide them into groups of 20
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1878 ;; and make a pane (or submenu) for each one.
|
21148
bbbd345f54de
(mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1879 (if (> (length alist) (/ (* mouse-buffer-menu-maxlen 3) 2))
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1880 (let ((alist alist) sublists next
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1881 (i 1))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1882 (while alist
|
21148
bbbd345f54de
(mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1883 ;; Pull off the next mouse-buffer-menu-maxlen buffers
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1884 ;; and make them the next element of sublist.
|
21148
bbbd345f54de
(mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1885 (setq next (nthcdr mouse-buffer-menu-maxlen alist))
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1886 (if next
|
21148
bbbd345f54de
(mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1887 (setcdr (nthcdr (1- mouse-buffer-menu-maxlen) alist)
|
16989
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1888 nil))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1889 (setq sublists (cons (cons (format "Buffers %d" i) alist)
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1890 sublists))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1891 (setq i (1+ i))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1892 (setq alist next))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1893 (nreverse sublists))
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1894 ;; Few buffers--put them all in one pane.
|
4e31b0ff76a9
(mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1895 (list (cons title alist))))
|
66
|
1896
|
1980
|
1897 ;;; These need to be rewritten for the new scroll bar implementation.
|
66
|
1898
|
1821
|
1899 ;;;!! ;; Commands for the scroll bar.
|
40268
|
1900 ;;;!!
|
1821
|
1901 ;;;!! (defun mouse-scroll-down (click)
|
|
1902 ;;;!! (interactive "@e")
|
|
1903 ;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
|
40268
|
1904 ;;;!!
|
1821
|
1905 ;;;!! (defun mouse-scroll-up (click)
|
|
1906 ;;;!! (interactive "@e")
|
|
1907 ;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
|
40268
|
1908 ;;;!!
|
1821
|
1909 ;;;!! (defun mouse-scroll-down-full ()
|
|
1910 ;;;!! (interactive "@")
|
|
1911 ;;;!! (scroll-down nil))
|
40268
|
1912 ;;;!!
|
1821
|
1913 ;;;!! (defun mouse-scroll-up-full ()
|
|
1914 ;;;!! (interactive "@")
|
|
1915 ;;;!! (scroll-up nil))
|
40268
|
1916 ;;;!!
|
1821
|
1917 ;;;!! (defun mouse-scroll-move-cursor (click)
|
|
1918 ;;;!! (interactive "@e")
|
|
1919 ;;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
|
40268
|
1920 ;;;!!
|
1821
|
1921 ;;;!! (defun mouse-scroll-absolute (event)
|
|
1922 ;;;!! (interactive "@e")
|
|
1923 ;;;!! (let* ((pos (car event))
|
|
1924 ;;;!! (position (car pos))
|
|
1925 ;;;!! (length (car (cdr pos))))
|
|
1926 ;;;!! (if (<= length 0) (setq length 1))
|
|
1927 ;;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
|
|
1928 ;;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
|
|
1929 ;;;!! position)
|
|
1930 ;;;!! length)
|
|
1931 ;;;!! scale-factor)))
|
|
1932 ;;;!! (goto-char newpos)
|
|
1933 ;;;!! (recenter '(4)))))
|
40268
|
1934 ;;;!!
|
1821
|
1935 ;;;!! (defun mouse-scroll-left (click)
|
|
1936 ;;;!! (interactive "@e")
|
|
1937 ;;;!! (scroll-left (1+ (car (mouse-coords click)))))
|
40268
|
1938 ;;;!!
|
1821
|
1939 ;;;!! (defun mouse-scroll-right (click)
|
|
1940 ;;;!! (interactive "@e")
|
|
1941 ;;;!! (scroll-right (1+ (car (mouse-coords click)))))
|
40268
|
1942 ;;;!!
|
1821
|
1943 ;;;!! (defun mouse-scroll-left-full ()
|
|
1944 ;;;!! (interactive "@")
|
|
1945 ;;;!! (scroll-left nil))
|
40268
|
1946 ;;;!!
|
1821
|
1947 ;;;!! (defun mouse-scroll-right-full ()
|
|
1948 ;;;!! (interactive "@")
|
|
1949 ;;;!! (scroll-right nil))
|
40268
|
1950 ;;;!!
|
1821
|
1951 ;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
|
|
1952 ;;;!! (interactive "@e")
|
|
1953 ;;;!! (move-to-column (1+ (car (mouse-coords click)))))
|
40268
|
1954 ;;;!!
|
1821
|
1955 ;;;!! (defun mouse-scroll-absolute-horizontally (event)
|
|
1956 ;;;!! (interactive "@e")
|
|
1957 ;;;!! (let* ((pos (car event))
|
|
1958 ;;;!! (position (car pos))
|
|
1959 ;;;!! (length (car (cdr pos))))
|
|
1960 ;;;!! (set-window-hscroll (selected-window) 33)))
|
40268
|
1961 ;;;!!
|
1821
|
1962 ;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
|
|
1963 ;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
|
|
1964 ;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
|
40268
|
1965 ;;;!!
|
1821
|
1966 ;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
|
|
1967 ;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
|
|
1968 ;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
|
40268
|
1969 ;;;!!
|
1821
|
1970 ;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
|
|
1971 ;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
|
|
1972 ;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
|
40268
|
1973 ;;;!!
|
1821
|
1974 ;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
|
|
1975 ;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
|
|
1976 ;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
|
40268
|
1977 ;;;!!
|
1821
|
1978 ;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
|
|
1979 ;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
|
|
1980 ;;;!! 'mouse-scroll-absolute-horizontally)
|
|
1981 ;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
|
40268
|
1982 ;;;!!
|
1821
|
1983 ;;;!! (global-set-key [horizontal-slider mouse-1]
|
|
1984 ;;;!! 'mouse-scroll-move-cursor-horizontally)
|
|
1985 ;;;!! (global-set-key [horizontal-slider mouse-2]
|
|
1986 ;;;!! 'mouse-scroll-move-cursor-horizontally)
|
|
1987 ;;;!! (global-set-key [horizontal-slider mouse-3]
|
|
1988 ;;;!! 'mouse-scroll-move-cursor-horizontally)
|
40268
|
1989 ;;;!!
|
1821
|
1990 ;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
|
|
1991 ;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
|
|
1992 ;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
|
40268
|
1993 ;;;!!
|
1821
|
1994 ;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
|
|
1995 ;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
|
|
1996 ;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
|
40268
|
1997 ;;;!!
|
1821
|
1998 ;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
|
|
1999 ;;;!! 'mouse-split-window-horizontally)
|
|
2000 ;;;!! (global-set-key [mode-line S-mouse-2]
|
|
2001 ;;;!! 'mouse-split-window-horizontally)
|
|
2002 ;;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
|
|
2003 ;;;!! 'mouse-split-window)
|
|
2004
|
|
2005 ;;;!! ;;;;
|
|
2006 ;;;!! ;;;; Here are experimental things being tested. Mouse events
|
|
2007 ;;;!! ;;;; are of the form:
|
|
2008 ;;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
|
|
2009 ;;;!! ;;
|
|
2010 ;;;!! ;;;;
|
|
2011 ;;;!! ;;;; Dynamically track mouse coordinates
|
|
2012 ;;;!! ;;;;
|
|
2013 ;;;!! ;;
|
|
2014 ;;;!! ;;(defun track-mouse (event)
|
|
2015 ;;;!! ;; "Track the coordinates, absolute and relative, of the mouse."
|
|
2016 ;;;!! ;; (interactive "@e")
|
|
2017 ;;;!! ;; (while mouse-grabbed
|
|
2018 ;;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
|
|
2019 ;;;!! ;; (abs-x (car pos))
|
|
2020 ;;;!! ;; (abs-y (cdr pos))
|
|
2021 ;;;!! ;; (relative-coordinate (coordinates-in-window-p
|
|
2022 ;;;!! ;; (list (car pos) (cdr pos))
|
|
2023 ;;;!! ;; (selected-window))))
|
|
2024 ;;;!! ;; (if (consp relative-coordinate)
|
|
2025 ;;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
|
|
2026 ;;;!! ;; (car relative-coordinate)
|
|
2027 ;;;!! ;; (car (cdr relative-coordinate)))
|
|
2028 ;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
|
40268
|
2029 ;;;!!
|
1821
|
2030 ;;;!! ;;
|
|
2031 ;;;!! ;; Dynamically put a box around the line indicated by point
|
|
2032 ;;;!! ;;
|
|
2033 ;;;!! ;;
|
|
2034 ;;;!! ;;(require 'backquote)
|
|
2035 ;;;!! ;;
|
|
2036 ;;;!! ;;(defun mouse-select-buffer-line (event)
|
|
2037 ;;;!! ;; (interactive "@e")
|
|
2038 ;;;!! ;; (let ((relative-coordinate
|
|
2039 ;;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
|
|
2040 ;;;!! ;; (abs-y (car (cdr (car event)))))
|
|
2041 ;;;!! ;; (if (consp relative-coordinate)
|
|
2042 ;;;!! ;; (progn
|
|
2043 ;;;!! ;; (save-excursion
|
|
2044 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
|
|
2045 ;;;!! ;; (x-draw-rectangle
|
|
2046 ;;;!! ;; (selected-screen)
|
|
2047 ;;;!! ;; abs-y 0
|
|
2048 ;;;!! ;; (save-excursion
|
|
2049 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
|
|
2050 ;;;!! ;; (end-of-line)
|
|
2051 ;;;!! ;; (push-mark nil t)
|
|
2052 ;;;!! ;; (beginning-of-line)
|
|
2053 ;;;!! ;; (- (region-end) (region-beginning))) 1))
|
|
2054 ;;;!! ;; (sit-for 1)
|
|
2055 ;;;!! ;; (x-erase-rectangle (selected-screen))))))
|
|
2056 ;;;!! ;;
|
|
2057 ;;;!! ;;(defvar last-line-drawn nil)
|
|
2058 ;;;!! ;;(defvar begin-delim "[^ \t]")
|
|
2059 ;;;!! ;;(defvar end-delim "[^ \t]")
|
|
2060 ;;;!! ;;
|
|
2061 ;;;!! ;;(defun mouse-boxing (event)
|
|
2062 ;;;!! ;; (interactive "@e")
|
|
2063 ;;;!! ;; (save-excursion
|
|
2064 ;;;!! ;; (let ((screen (selected-screen)))
|
|
2065 ;;;!! ;; (while (= (x-mouse-events) 0)
|
|
2066 ;;;!! ;; (let* ((pos (read-mouse-position screen))
|
|
2067 ;;;!! ;; (abs-x (car pos))
|
|
2068 ;;;!! ;; (abs-y (cdr pos))
|
|
2069 ;;;!! ;; (relative-coordinate
|
41611
|
2070 ;;;!! ;; (coordinates-in-window-p `(,abs-x ,abs-y)
|
1821
|
2071 ;;;!! ;; (selected-window)))
|
|
2072 ;;;!! ;; (begin-reg nil)
|
|
2073 ;;;!! ;; (end-reg nil)
|
|
2074 ;;;!! ;; (end-column nil)
|
|
2075 ;;;!! ;; (begin-column nil))
|
|
2076 ;;;!! ;; (if (and (consp relative-coordinate)
|
|
2077 ;;;!! ;; (or (not last-line-drawn)
|
|
2078 ;;;!! ;; (not (= last-line-drawn abs-y))))
|
|
2079 ;;;!! ;; (progn
|
|
2080 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
|
|
2081 ;;;!! ;; (if (= (following-char) 10)
|
|
2082 ;;;!! ;; ()
|
|
2083 ;;;!! ;; (progn
|
|
2084 ;;;!! ;; (setq begin-reg (1- (re-search-forward end-delim)))
|
|
2085 ;;;!! ;; (setq begin-column (1- (current-column)))
|
|
2086 ;;;!! ;; (end-of-line)
|
|
2087 ;;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim)))
|
|
2088 ;;;!! ;; (setq end-column (1+ (current-column)))
|
|
2089 ;;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
|
|
2090 ;;;!! ;; (x-draw-rectangle screen
|
|
2091 ;;;!! ;; (setq last-line-drawn abs-y)
|
|
2092 ;;;!! ;; begin-column
|
|
2093 ;;;!! ;; (- end-column begin-column) 1))))))))))
|
|
2094 ;;;!! ;;
|
|
2095 ;;;!! ;;(defun mouse-erase-box ()
|
|
2096 ;;;!! ;; (interactive)
|
|
2097 ;;;!! ;; (if last-line-drawn
|
|
2098 ;;;!! ;; (progn
|
|
2099 ;;;!! ;; (x-erase-rectangle (selected-screen))
|
|
2100 ;;;!! ;; (setq last-line-drawn nil))))
|
40268
|
2101 ;;;!!
|
1821
|
2102 ;;;!! ;;; (defun test-x-rectangle ()
|
|
2103 ;;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
|
|
2104 ;;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
|
|
2105 ;;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
|
40268
|
2106 ;;;!!
|
1821
|
2107 ;;;!! ;;
|
|
2108 ;;;!! ;; Here is how to do double clicking in lisp. About to change.
|
|
2109 ;;;!! ;;
|
40268
|
2110 ;;;!!
|
1821
|
2111 ;;;!! (defvar double-start nil)
|
|
2112 ;;;!! (defconst double-click-interval 300
|
|
2113 ;;;!! "Max ticks between clicks")
|
40268
|
2114 ;;;!!
|
1821
|
2115 ;;;!! (defun double-down (event)
|
|
2116 ;;;!! (interactive "@e")
|
|
2117 ;;;!! (if double-start
|
|
2118 ;;;!! (let ((interval (- (nth 4 event) double-start)))
|
|
2119 ;;;!! (if (< interval double-click-interval)
|
|
2120 ;;;!! (progn
|
|
2121 ;;;!! (backward-up-list 1)
|
|
2122 ;;;!! ;; (message "Interval %d" interval)
|
|
2123 ;;;!! (sleep-for 1)))
|
|
2124 ;;;!! (setq double-start nil))
|
|
2125 ;;;!! (setq double-start (nth 4 event))))
|
40268
|
2126 ;;;!!
|
1821
|
2127 ;;;!! (defun double-up (event)
|
|
2128 ;;;!! (interactive "@e")
|
|
2129 ;;;!! (and double-start
|
|
2130 ;;;!! (> (- (nth 4 event ) double-start) double-click-interval)
|
|
2131 ;;;!! (setq double-start nil)))
|
40268
|
2132 ;;;!!
|
1821
|
2133 ;;;!! ;;; (defun x-test-doubleclick ()
|
|
2134 ;;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
|
|
2135 ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
|
|
2136 ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
|
40268
|
2137 ;;;!!
|
1821
|
2138 ;;;!! ;;
|
1980
|
2139 ;;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar.
|
1821
|
2140 ;;;!! ;;
|
40268
|
2141 ;;;!!
|
1821
|
2142 ;;;!! (defvar scrolled-lines 0)
|
|
2143 ;;;!! (defconst scroll-speed 1)
|
40268
|
2144 ;;;!!
|
1821
|
2145 ;;;!! (defun incr-scroll-down (event)
|
|
2146 ;;;!! (interactive "@e")
|
|
2147 ;;;!! (setq scrolled-lines 0)
|
|
2148 ;;;!! (incremental-scroll scroll-speed))
|
40268
|
2149 ;;;!!
|
1821
|
2150 ;;;!! (defun incr-scroll-up (event)
|
|
2151 ;;;!! (interactive "@e")
|
|
2152 ;;;!! (setq scrolled-lines 0)
|
|
2153 ;;;!! (incremental-scroll (- scroll-speed)))
|
40268
|
2154 ;;;!!
|
1821
|
2155 ;;;!! (defun incremental-scroll (n)
|
|
2156 ;;;!! (while (= (x-mouse-events) 0)
|
|
2157 ;;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
|
|
2158 ;;;!! (scroll-down n)
|
|
2159 ;;;!! (sit-for 300 t)))
|
40268
|
2160 ;;;!!
|
1821
|
2161 ;;;!! (defun incr-scroll-stop (event)
|
|
2162 ;;;!! (interactive "@e")
|
|
2163 ;;;!! (message "Scrolled %d lines" scrolled-lines)
|
|
2164 ;;;!! (setq scrolled-lines 0)
|
|
2165 ;;;!! (sleep-for 1))
|
40268
|
2166 ;;;!!
|
1821
|
2167 ;;;!! ;;; (defun x-testing-scroll ()
|
|
2168 ;;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
|
|
2169 ;;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
|
|
2170 ;;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
|
|
2171 ;;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
|
|
2172 ;;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
|
40268
|
2173 ;;;!!
|
1821
|
2174 ;;;!! ;;
|
|
2175 ;;;!! ;; Some playthings suitable for picture mode? They need work.
|
|
2176 ;;;!! ;;
|
40268
|
2177 ;;;!!
|
1821
|
2178 ;;;!! (defun mouse-kill-rectangle (event)
|
|
2179 ;;;!! "Kill the rectangle between point and the mouse cursor."
|
|
2180 ;;;!! (interactive "@e")
|
|
2181 ;;;!! (let ((point-save (point)))
|
|
2182 ;;;!! (save-excursion
|
|
2183 ;;;!! (mouse-set-point event)
|
|
2184 ;;;!! (push-mark nil t)
|
|
2185 ;;;!! (if (> point-save (point))
|
|
2186 ;;;!! (kill-rectangle (point) point-save)
|
|
2187 ;;;!! (kill-rectangle point-save (point))))))
|
40268
|
2188 ;;;!!
|
1821
|
2189 ;;;!! (defun mouse-open-rectangle (event)
|
|
2190 ;;;!! "Kill the rectangle between point and the mouse cursor."
|
|
2191 ;;;!! (interactive "@e")
|
|
2192 ;;;!! (let ((point-save (point)))
|
|
2193 ;;;!! (save-excursion
|
|
2194 ;;;!! (mouse-set-point event)
|
|
2195 ;;;!! (push-mark nil t)
|
|
2196 ;;;!! (if (> point-save (point))
|
|
2197 ;;;!! (open-rectangle (point) point-save)
|
|
2198 ;;;!! (open-rectangle point-save (point))))))
|
40268
|
2199 ;;;!!
|
1821
|
2200 ;;;!! ;; Must be a better way to do this.
|
40268
|
2201 ;;;!!
|
1821
|
2202 ;;;!! (defun mouse-multiple-insert (n char)
|
|
2203 ;;;!! (while (> n 0)
|
|
2204 ;;;!! (insert char)
|
|
2205 ;;;!! (setq n (1- n))))
|
40268
|
2206 ;;;!!
|
1821
|
2207 ;;;!! ;; What this could do is not finalize until button was released.
|
40268
|
2208 ;;;!!
|
1821
|
2209 ;;;!! (defun mouse-move-text (event)
|
|
2210 ;;;!! "Move text from point to cursor position, inserting spaces."
|
|
2211 ;;;!! (interactive "@e")
|
|
2212 ;;;!! (let* ((relative-coordinate
|
|
2213 ;;;!! (coordinates-in-window-p (car event) (selected-window))))
|
|
2214 ;;;!! (if (consp relative-coordinate)
|
|
2215 ;;;!! (cond ((> (current-column) (car relative-coordinate))
|
|
2216 ;;;!! (delete-char
|
|
2217 ;;;!! (- (car relative-coordinate) (current-column))))
|
|
2218 ;;;!! ((< (current-column) (car relative-coordinate))
|
|
2219 ;;;!! (mouse-multiple-insert
|
|
2220 ;;;!! (- (car relative-coordinate) (current-column)) " "))
|
|
2221 ;;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
|
1100
|
2222
|
4081
|
2223 ;; Choose a completion with the mouse.
|
|
2224
|
|
2225 (defun mouse-choose-completion (event)
|
4371
|
2226 "Click on an alternative in the `*Completions*' buffer to choose it."
|
4081
|
2227 (interactive "e")
|
10258
|
2228 ;; Give temporary modes such as isearch a chance to turn off.
|
|
2229 (run-hooks 'mouse-leave-buffer-hook)
|
4788
|
2230 (let ((buffer (window-buffer))
|
8477
|
2231 choice
|
|
2232 base-size)
|
4081
|
2233 (save-excursion
|
|
2234 (set-buffer (window-buffer (posn-window (event-start event))))
|
6163
|
2235 (if completion-reference-buffer
|
|
2236 (setq buffer completion-reference-buffer))
|
8477
|
2237 (setq base-size completion-base-size)
|
4081
|
2238 (save-excursion
|
|
2239 (goto-char (posn-point (event-start event)))
|
7593
|
2240 (let (beg end)
|
8204
f5c8a4e8c4a5
(mouse-choose-completion): Use mouse-face properties to find string to use.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2241 (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
|
f5c8a4e8c4a5
(mouse-choose-completion): Use mouse-face properties to find string to use.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2242 (setq end (point) beg (1+ (point))))
|
f5c8a4e8c4a5
(mouse-choose-completion): Use mouse-face properties to find string to use.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2243 (if (null beg)
|
f5c8a4e8c4a5
(mouse-choose-completion): Use mouse-face properties to find string to use.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2244 (error "No completion here"))
|
f5c8a4e8c4a5
(mouse-choose-completion): Use mouse-face properties to find string to use.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2245 (setq beg (previous-single-property-change beg 'mouse-face))
|
8381
9d751556d1c7
(mouse-choose-completion): Check for next-single-property-change
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2246 (setq end (or (next-single-property-change end 'mouse-face)
|
9d751556d1c7
(mouse-choose-completion): Check for next-single-property-change
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2247 (point-max)))
|
67779
|
2248 (setq choice (buffer-substring-no-properties beg end)))))
|
6231
|
2249 (let ((owindow (selected-window)))
|
|
2250 (select-window (posn-window (event-start event)))
|
7794
|
2251 (if (and (one-window-p t 'selected-frame)
|
|
2252 (window-dedicated-p (selected-window)))
|
|
2253 ;; This is a special buffer's frame
|
|
2254 (iconify-frame (selected-frame))
|
|
2255 (or (window-dedicated-p (selected-window))
|
|
2256 (bury-buffer)))
|
6231
|
2257 (select-window owindow))
|
8477
|
2258 (choose-completion-string choice buffer base-size)))
|
4081
|
2259
|
1100
|
2260 ;; Font selection.
|
465
|
2261
|
4294
|
2262 (defun font-menu-add-default ()
|
|
2263 (let* ((default (cdr (assq 'font (frame-parameters (selected-frame)))))
|
|
2264 (font-alist x-fixed-font-alist)
|
4563
|
2265 (elt (or (assoc "Misc" font-alist) (nth 1 font-alist))))
|
4294
|
2266 (if (assoc "Default" elt)
|
|
2267 (delete (assoc "Default" elt) elt))
|
|
2268 (setcdr elt
|
25547
|
2269 (cons (list "Default" default)
|
4294
|
2270 (cdr elt)))))
|
|
2271
|
1100
|
2272 (defvar x-fixed-font-alist
|
|
2273 '("Font menu"
|
|
2274 ("Misc"
|
8460
|
2275 ;; For these, we specify the pixel height and width.
|
|
2276 ("fixed" "fixed")
|
|
2277 ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10")
|
|
2278 ("6x12"
|
|
2279 "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12")
|
|
2280 ("6x13"
|
|
2281 "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13")
|
|
2282 ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13")
|
|
2283 ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14")
|
|
2284 ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13")
|
|
2285 ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15")
|
|
2286 ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20")
|
|
2287 ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18")
|
|
2288 ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24")
|
4274
|
2289 ("")
|
8487
|
2290 ("clean 5x8"
|
|
2291 "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1")
|
|
2292 ("clean 6x8"
|
|
2293 "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1")
|
8460
|
2294 ("clean 8x8"
|
|
2295 "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1")
|
|
2296 ("clean 8x10"
|
|
2297 "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1")
|
|
2298 ("clean 8x14"
|
|
2299 "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1")
|
|
2300 ("clean 8x16"
|
|
2301 "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1")
|
4274
|
2302 ("")
|
25097
|
2303 ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1")
|
1100
|
2304 ;;; We don't seem to have these; who knows what they are.
|
|
2305 ;;; ("fg-18" "fg-18")
|
|
2306 ;;; ("fg-25" "fg-25")
|
25097
|
2307 ("lucidasanstypewriter-12" "-b&h-lucidatypewriter-medium-r-normal-sans-*-120-*-*-*-*-iso8859-1")
|
|
2308 ("lucidasanstypewriter-bold-14" "-b&h-lucidatypewriter-bold-r-normal-sans-*-140-*-*-*-*-iso8859-1")
|
|
2309 ("lucidasanstypewriter-bold-24"
|
|
2310 "-b&h-lucidatypewriter-bold-r-normal-sans-*-240-*-*-*-*-iso8859-1")
|
1100
|
2311 ;;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1")
|
|
2312 ;;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
|
25097
|
2313 )
|
1100
|
2314 ("Courier"
|
8460
|
2315 ;; For these, we specify the point height.
|
3231
|
2316 ("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1")
|
|
2317 ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1")
|
|
2318 ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1")
|
|
2319 ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1")
|
|
2320 ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1")
|
|
2321 ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1")
|
|
2322 ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1")
|
|
2323 ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1")
|
|
2324 ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1")
|
|
2325 ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1")
|
|
2326 ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1")
|
|
2327 ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1")
|
|
2328 ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1")
|
|
2329 ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1")
|
|
2330 ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1")
|
|
2331 ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1")
|
|
2332 ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1")
|
|
2333 ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1")
|
|
2334 ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1")
|
|
2335 ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1")
|
|
2336 ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1")
|
|
2337 ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1")
|
|
2338 ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1")
|
|
2339 ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1"))
|
1100
|
2340 )
|
|
2341 "X fonts suitable for use in Emacs.")
|
|
2342
|
6867
0f4c8109274a
(x-fixed-font-alist): Give multiple names for try for certain fonts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2343 (defun mouse-set-font (&rest fonts)
|
17008
|
2344 "Select an emacs font from a list of known good fonts and fontsets."
|
1100
|
2345 (interactive
|
45570
1739a350f81c
(mouse-set-font): Avoid misleading error message if user makes no selection.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2346 (progn (unless (display-multi-font-p)
|
1739a350f81c
(mouse-set-font): Avoid misleading error message if user makes no selection.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2347 (error "Cannot change fonts on this display"))
|
1739a350f81c
(mouse-set-font): Avoid misleading error message if user makes no selection.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2348 (x-popup-menu
|
58837
e3c6ff0922c2
(mouse-set-font): Handle the case where the command was not invoked
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
2349 (if (listp last-nonmenu-event)
|
e3c6ff0922c2
(mouse-set-font): Handle the case where the command was not invoked
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
2350 last-nonmenu-event
|
e3c6ff0922c2
(mouse-set-font): Handle the case where the command was not invoked
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
2351 (list '(0 0) (selected-window)))
|
45570
1739a350f81c
(mouse-set-font): Avoid misleading error message if user makes no selection.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2352 ;; Append list of fontsets currently defined.
|
1739a350f81c
(mouse-set-font): Avoid misleading error message if user makes no selection.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2353 (append x-fixed-font-alist (list (generate-fontset-menu))))))
|
6914
|
2354 (if fonts
|
|
2355 (let (font)
|
|
2356 (while fonts
|
|
2357 (condition-case nil
|
|
2358 (progn
|
7021
|
2359 (set-default-font (car fonts))
|
6914
|
2360 (setq font (car fonts))
|
|
2361 (setq fonts nil))
|
7021
|
2362 (error
|
|
2363 (setq fonts (cdr fonts)))))
|
6914
|
2364 (if (null font)
|
45570
1739a350f81c
(mouse-set-font): Avoid misleading error message if user makes no selection.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2365 (error "Font not found")))))
|
465
|
2366
|
|
2367 ;;; Bindings for mouse commands.
|
|
2368
|
2799
|
2369 (define-key global-map [down-mouse-1] 'mouse-drag-region)
|
1821
|
2370 (global-set-key [mouse-1] 'mouse-set-point)
|
2799
|
2371 (global-set-key [drag-mouse-1] 'mouse-set-region)
|
1057
|
2372
|
4738
|
2373 ;; These are tested for in mouse-drag-region.
|
|
2374 (global-set-key [double-mouse-1] 'mouse-set-point)
|
|
2375 (global-set-key [triple-mouse-1] 'mouse-set-point)
|
|
2376
|
53133
|
2377 ;; Clicking on the fringes causes hscrolling:
|
|
2378 (global-set-key [left-fringe mouse-1] 'mouse-set-point)
|
|
2379 (global-set-key [right-fringe mouse-1] 'mouse-set-point)
|
|
2380
|
1821
|
2381 (global-set-key [mouse-2] 'mouse-yank-at-click)
|
|
2382 (global-set-key [mouse-3] 'mouse-save-then-kill)
|
705
|
2383
|
1821
|
2384 ;; By binding these to down-going events, we let the user use the up-going
|
|
2385 ;; event to make the selection, saving a click.
|
13038
|
2386 (global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
|
|
2387 (if (not (eq system-type 'ms-dos))
|
|
2388 (global-set-key [S-down-mouse-1] 'mouse-set-font))
|
9753
|
2389 ;; C-down-mouse-2 is bound in facemenu.el.
|
30328
|
2390 (global-set-key [C-down-mouse-3] 'mouse-popup-menubar-stuff)
|
9488
|
2391
|
1100
|
2392
|
1056
|
2393 ;; Replaced with dragging mouse-1
|
|
2394 ;; (global-set-key [S-mouse-1] 'mouse-set-mark)
|
1214
|
2395
|
32327
|
2396 ;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
|
|
2397 ;; vertical-line prevents Emacs from signaling an error when the mouse
|
|
2398 ;; button is released after dragging these lines, on non-toolkit
|
|
2399 ;; versions.
|
6090
|
2400 (global-set-key [mode-line mouse-1] 'mouse-select-window)
|
8519
|
2401 (global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
|
|
2402 (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
|
25618
|
2403 (global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
|
32327
|
2404 (global-set-key [header-line mouse-1] 'mouse-select-window)
|
6090
|
2405 (global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
|
1821
|
2406 (global-set-key [mode-line mouse-3] 'mouse-delete-window)
|
6090
|
2407 (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
|
8174
|
2408 (global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
|
8268
|
2409 (global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
|
13038
|
2410 (global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
|
|
2411 (global-set-key [vertical-line mouse-1] 'mouse-select-window)
|
584
|
2412
|
|
2413 (provide 'mouse)
|
|
2414
|
25288
|
2415 ;; This file contains the functionality of the old mldrag.el.
|
|
2416 (defalias 'mldrag-drag-mode-line 'mouse-drag-mode-line)
|
|
2417 (defalias 'mldrag-drag-vertical-line 'mouse-drag-vertical-line)
|
29353
|
2418 (make-obsolete 'mldrag-drag-mode-line 'mouse-drag-mode-line "21.1")
|
|
2419 (make-obsolete 'mldrag-drag-vertical-line 'mouse-drag-vertical-line "21.1")
|
25288
|
2420 (provide 'mldrag)
|
|
2421
|
65623
|
2422 ;; arch-tag: 9a710ce1-914a-4923-9b81-697f7bf82ab3
|
659
|
2423 ;;; mouse.el ends here
|