annotate lisp/mouse.el @ 69401:259ab035a718

Add x_fully_uncatch_errors and x_catching_errors to the list of unused display error handling functions.
author Eli Zaretskii <eliz@gnu.org>
date Sat, 11 Mar 2006 16:02:38 +0000
parents bb38a98ef7ad
children 4540a0223bcc d57ee9eab157
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
1 ;;; mouse.el --- window system-independent mouse support
791
203c23c9f22c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 758
diff changeset
2
64762
41bb365f41c4 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64091
diff changeset
3 ;; Copyright (C) 1993, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
68651
3bd95f4f2941 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 67997
diff changeset
4 ;; 2004, 2005, 2006 Free Software Foundation, Inc.
840
113281b361ec *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 791
diff changeset
5
791
203c23c9f22c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 758
diff changeset
6 ;; Maintainer: FSF
30328
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
7 ;; Keywords: hardware, mouse
791
203c23c9f22c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 758
diff changeset
8
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
9 ;; This file is part of GNU Emacs.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
14 ;; any later version.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
19 ;; GNU General Public License for more details.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
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>
parents: 13872
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64091
6fb026ad601f Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 63849
diff changeset
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
6fb026ad601f Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 63849
diff changeset
24 ;; Boston, MA 02110-1301, USA.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25
2308
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
26 ;;; Commentary:
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
27
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
28 ;; This package provides various useful commands (including help
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
29 ;; system access) through the mouse. All this code assumes that mouse
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
30 ;; interpretation has been abstracted into Emacs input events.
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
31 ;;
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
32 ;; The code is rather X-dependent.
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
33
2232
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2070
diff changeset
34 ;;; Code:
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2070
diff changeset
35
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
36 ;;; Utility functions.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
37
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
38 ;;; Indent track-mouse like progn.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
39 (put 'track-mouse 'lisp-indent-function 0)
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
41 (defcustom mouse-yank-at-point nil
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
42 "*If non-nil, mouse yank commands yank at point instead of at click."
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
43 :type 'boolean
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
44 :group 'mouse)
55260
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
45
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
46 (defcustom mouse-drag-copy-region t
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
47 "*If non-nil, mouse drag copies region to kill-ring."
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
48 :type 'boolean
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 59526
diff changeset
49 :version "22.1"
55260
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
50 :group 'mouse)
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
51
61160
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
52 (defcustom mouse-1-click-follows-link 450
59036
f1a383c1b9cd (mouse-1-click-follows-link): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 59016
diff changeset
53 "Non-nil means that clicking Mouse-1 on a link follows the link.
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
54
59036
f1a383c1b9cd (mouse-1-click-follows-link): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 59016
diff changeset
55 With the default setting, an ordinary Mouse-1 click on a link
f1a383c1b9cd (mouse-1-click-follows-link): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 59016
diff changeset
56 performs the same action as Mouse-2 on that link, while a longer
66123
e7767b4c6597 (mouse-1-click-follows-link): Doc fix.
Romain Francoise <romain@orebokech.com>
parents: 66085
diff changeset
57 Mouse-1 click \(hold down the Mouse-1 button for more than 450
59036
f1a383c1b9cd (mouse-1-click-follows-link): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 59016
diff changeset
58 milliseconds) performs the original Mouse-1 binding \(which
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
59 typically sets point where you click the mouse).
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
60
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
61 If value is an integer, the time elapsed between pressing and
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
62 releasing the mouse button determines whether to follow the link
59036
f1a383c1b9cd (mouse-1-click-follows-link): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 59016
diff changeset
63 or perform the normal Mouse-1 action (typically set point).
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
64 The absolute numeric value specifices the maximum duration of a
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
65 \"short click\" in milliseconds. A positive value means that a
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
66 short click follows the link, and a longer click performs the
63256
08eb8fe4b5ef (mouse-1-click-follows-link): Fix spellings in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents: 61767
diff changeset
67 normal action. A negative value gives the opposite behavior.
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
68
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
69 If value is `double', a double click follows the link.
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
70
59036
f1a383c1b9cd (mouse-1-click-follows-link): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 59016
diff changeset
71 Otherwise, a single Mouse-1 click unconditionally follows the link.
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
72
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
73 Note that dragging the mouse never follows the link.
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
74
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
75 This feature only works in modes that specifically identify
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
76 clickable text as links, so it may not work with some external
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
77 packages. See `mouse-on-link-p' for details."
59996
aac0a33f5772 Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents: 59526
diff changeset
78 :version "22.1"
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
79 :type '(choice (const :tag "Disabled" nil)
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
80 (const :tag "Double click" double)
66123
e7767b4c6597 (mouse-1-click-follows-link): Doc fix.
Romain Francoise <romain@orebokech.com>
parents: 66085
diff changeset
81 (number :tag "Single click time limit" :value 450)
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
82 (other :tag "Single click" t))
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
83 :group 'mouse)
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
84
60253
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
85 (defcustom mouse-1-click-in-non-selected-windows t
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
86 "*If non-nil, a Mouse-1 click also follows links in non-selected windows.
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
87
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
88 If nil, a Mouse-1 click on a link in a non-selected window performs
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
89 the normal mouse-1 binding, typically selects the window and sets
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
90 point at the click position."
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
91 :type 'boolean
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
92 :version "22.1"
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
93 :group 'mouse)
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
94
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
95
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
96
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
97 ;; Provide a mode-specific menu on a mouse button.
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
98
30312
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
99 (defun popup-menu (menu &optional position prefix)
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
100 "Popup the given menu and call the selected option.
30328
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
101 MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
102 `x-popup-menu'.
30312
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
103 POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and defaults to
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
104 the current mouse position.
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
105 PREFIX is the prefix argument (if any) to pass to the command."
30328
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
106 (let* ((map (cond
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
107 ((keymapp menu) menu)
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
108 ((and (listp menu) (keymapp (car menu))) menu)
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
109 (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
33769
7596dea75d6b (popup-menu): Stupid typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32327
diff changeset
110 (filter (when (symbolp map)
7596dea75d6b (popup-menu): Stupid typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32327
diff changeset
111 (plist-get (get map 'menu-prop) :filter))))
7596dea75d6b (popup-menu): Stupid typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32327
diff changeset
112 (if filter (funcall filter (symbol-function map)) map)))))
32312
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
113 event cmd)
31912
83fe15f82f7e (popup-menu): If POSITION is nil, set it using
Dave Love <fx@gnu.org>
parents: 31390
diff changeset
114 (unless position
31923
d257713e8d6d Fix last change.
Dave Love <fx@gnu.org>
parents: 31912
diff changeset
115 (let ((mp (mouse-pixel-position)))
31912
83fe15f82f7e (popup-menu): If POSITION is nil, set it using
Dave Love <fx@gnu.org>
parents: 31390
diff changeset
116 (setq position (list (list (cadr mp) (cddr mp)) (car mp)))))
30312
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
117 ;; The looping behavior was taken from lmenu's popup-menu-popup
30421
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
118 (while (and map (setq event
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
119 ;; map could be a prefix key, in which case
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
120 ;; we need to get its function cell
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
121 ;; definition.
31923
d257713e8d6d Fix last change.
Dave Love <fx@gnu.org>
parents: 31912
diff changeset
122 (x-popup-menu position (indirect-function map))))
30312
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
123 ;; Strangely x-popup-menu returns a list.
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
124 ;; mouse-major-mode-menu was using a weird:
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
125 ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
32312
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
126 (setq cmd
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
127 (if (and (not (keymapp map)) (listp map))
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
128 ;; We were given a list of keymaps. Search them all
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
129 ;; in sequence until a first binding is found.
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
130 (let ((mouse-click (apply 'vector event))
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
131 binding)
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
132 (while (and map (null binding))
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
133 (setq binding (lookup-key (car map) mouse-click))
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
134 (if (numberp binding) ; `too long'
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
135 (setq binding nil))
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
136 (setq map (cdr map)))
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
137 binding)
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
138 ;; We were given a single keymap.
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
139 (lookup-key map (apply 'vector event))))
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
140 ;; Clear out echoing, which perhaps shows a prefix arg.
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
141 (message "")
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
142 ;; Maybe try again but with the submap.
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
143 (setq map (if (keymapp cmd) cmd)))
40648
a48a4d0806b4 (popup-menu): If the user refuses to select
Richard M. Stallman <rms@gnu.org>
parents: 40379
diff changeset
144 ;; If the user did not cancel by refusing to select,
a48a4d0806b4 (popup-menu): If the user refuses to select
Richard M. Stallman <rms@gnu.org>
parents: 40379
diff changeset
145 ;; and if the result is a command, run it.
a48a4d0806b4 (popup-menu): If the user refuses to select
Richard M. Stallman <rms@gnu.org>
parents: 40379
diff changeset
146 (when (and (null map) (commandp cmd))
32312
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
147 (setq prefix-arg prefix)
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
148 ;; `setup-specified-language-environment', for instance,
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
149 ;; expects this to be set from a menu keymap.
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
150 (setq last-command-event (car (last event)))
b95ac47063ce (popup-menu): Move the command call outside the loop
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32269
diff changeset
151 ;; mouse-major-mode-menu was using `command-execute' instead.
32319
452e7cc818ac (popup-menu): Balance parens.
Miles Bader <miles@gnu.org>
parents: 32312
diff changeset
152 (call-interactively cmd))))
30425
ad577e2e48d3 (popup-menu): Set last-command-event.
Dave Love <fx@gnu.org>
parents: 30421
diff changeset
153
ad577e2e48d3 (popup-menu): Set last-command-event.
Dave Love <fx@gnu.org>
parents: 30421
diff changeset
154 (defvar mouse-major-mode-menu-prefix) ; dynamically bound
ad577e2e48d3 (popup-menu): Set last-command-event.
Dave Love <fx@gnu.org>
parents: 30421
diff changeset
155
65498
f2fdccb16607 2005-09-14 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 65349
diff changeset
156 (defun mouse-major-mode-menu (event &optional prefix)
24960
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
157 "Pop up a mode-specific menu of mouse commands.
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
158 Default to the Edit menu if the major mode doesn't define a menu."
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
159 ;; Switch to the window clicked on, because otherwise
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
160 ;; the mode's commands may not make sense.
16621
042bf1d82a14 (mouse-major-mode-menu): Propagate prefix arg
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
161 (interactive "@e\nP")
21953
6655c426d447 (mouse-major-mode-menu): Run activate-menubar-hook here.
Richard M. Stallman <rms@gnu.org>
parents: 21685
diff changeset
162 ;; Let the mode update its menus first.
31390
cf8964e1d7e3 (mouse-major-mode-menu, mouse-popup-menubar): Run
Dave Love <fx@gnu.org>
parents: 31329
diff changeset
163 (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
24960
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
164 (let* (;; This is where mouse-major-mode-menu-prefix
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
165 ;; returns the prefix we should use (after menu-bar).
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
166 ;; It is either nil or (SOME-SYMBOL).
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
167 (mouse-major-mode-menu-prefix nil)
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
168 ;; Keymap from which to inherit; may be null.
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
169 (ancestor (mouse-major-mode-menu-1
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
170 (and (current-local-map)
31258
12f2e341ee9c (mouse-major-mode-menu): Use local-key-binding.
Dave Love <fx@gnu.org>
parents: 30425
diff changeset
171 (local-key-binding [menu-bar]))))
24960
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
172 ;; Make a keymap in which our last command leads to a menu or
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
173 ;; default to the edit menu.
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
174 (newmap (if ancestor
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
175 (make-sparse-keymap (concat mode-name " Mode"))
65498
f2fdccb16607 2005-09-14 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 65349
diff changeset
176 menu-bar-edit-menu)))
24960
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
177 (if ancestor
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
178 ;; Make our menu inherit from the desired keymap which we want
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
179 ;; to display as the menu now.
00d2eba70774 (mouse-major-mode-menu): Default to menu-bar-edit-menu
Dave Love <fx@gnu.org>
parents: 23854
diff changeset
180 (set-keymap-parent newmap ancestor))
30312
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
181 (popup-menu newmap event prefix)))
a97801b43475 (popup-menu): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 30249
diff changeset
182
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
183
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
184 ;; Compute and cache the equivalent keys in MENU and all its submenus.
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
185 ;;;(defun mouse-major-mode-menu-compute-equiv-keys (menu)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
186 ;;; (and (eq (car menu) 'keymap)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
187 ;;; (x-popup-menu nil menu))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
188 ;;; (while menu
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
189 ;;; (and (consp (car menu))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
190 ;;; (consp (cdr (car menu)))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
191 ;;; (let ((tail (cdr (car menu))))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
192 ;;; (while (and (consp tail)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
193 ;;; (not (eq (car tail) 'keymap)))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
194 ;;; (setq tail (cdr tail)))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
195 ;;; (if (consp tail)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
196 ;;; (mouse-major-mode-menu-compute-equiv-keys tail))))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
197 ;;; (setq menu (cdr menu))))
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
198
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
199 ;; Given a mode's menu bar keymap,
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
200 ;; if it defines exactly one menu bar menu,
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
201 ;; return just that menu.
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
202 ;; Otherwise return a menu for all of them.
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
203 (defun mouse-major-mode-menu-1 (menubar)
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
204 (if menubar
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
205 (let ((tail menubar)
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
206 submap)
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
207 (while tail
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
208 (if (consp (car tail))
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
209 (if submap
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
210 (setq submap t)
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
211 (setq submap (car tail))))
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
212 (setq tail (cdr tail)))
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
213 (if (eq submap t)
15657
6ad5994053af (mouse-major-mode-menu-1): No need to copy the top
Karl Heuer <kwzh@gnu.org>
parents: 15642
diff changeset
214 menubar
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
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>
parents: 30122
diff changeset
216 (lookup-key menubar (vector (car submap)))))))
30328
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
217
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
218 (defun mouse-popup-menubar (event prefix)
52405
970694efa9b5 (mouse-popup-menubar, mouse-skip-word): Doc fix.
Dave Love <fx@gnu.org>
parents: 52401
diff changeset
219 "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX.
30328
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
220 The contents are the items that would be in the menu bar whether or
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
221 not it is actually displayed."
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
222 (interactive "@e \nP")
31390
cf8964e1d7e3 (mouse-major-mode-menu, mouse-popup-menubar): Run
Dave Love <fx@gnu.org>
parents: 31329
diff changeset
223 (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
30421
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
224 (let* ((local-menu (and (current-local-map)
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
225 (lookup-key (current-local-map) [menu-bar])))
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
226 (global-menu (lookup-key global-map [menu-bar]))
31329
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
227 ;; If a keymap doesn't have a prompt string (a lazy
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
228 ;; programmer didn't bother to provide one), create it and
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
229 ;; insert it into the keymap; each keymap gets its own
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
230 ;; prompt. This is required for non-toolkit versions to
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
231 ;; display non-empty menu pane names.
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
232 (minor-mode-menus
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
233 (mapcar
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
234 (function
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
235 (lambda (menu)
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
236 (let* ((minor-mode (car menu))
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
237 (menu (cdr menu))
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
238 (title-or-map (cadr menu)))
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
239 (or (stringp title-or-map)
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
240 (setq menu
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
241 (cons 'keymap
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
242 (cons (concat
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
243 (capitalize (subst-char-in-string
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
244 ?- ?\ (symbol-name
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
245 minor-mode)))
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
246 " Menu")
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
247 (cdr menu)))))
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
248 menu)))
f329cce08485 (mouse-popup-menubar): Supply the prompt string for
Eli Zaretskii <eliz@gnu.org>
parents: 31258
diff changeset
249 (minor-mode-key-binding [menu-bar])))
30421
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
250 (local-title-or-map (and local-menu (cadr local-menu)))
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
251 (global-title-or-map (cadr global-menu)))
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
252 (or (null local-menu)
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
253 (stringp local-title-or-map)
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
254 (setq local-menu (cons 'keymap
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
255 (cons (concat mode-name " Mode Menu")
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
256 (cdr local-menu)))))
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
257 (or (stringp global-title-or-map)
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
258 (setq global-menu (cons 'keymap
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
259 (cons "Global Menu"
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
260 (cdr global-menu)))))
30328
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
261 ;; Supplying the list is faster than making a new map.
31258
12f2e341ee9c (mouse-major-mode-menu): Use local-key-binding.
Dave Love <fx@gnu.org>
parents: 30425
diff changeset
262 (popup-menu (append (list global-menu)
12f2e341ee9c (mouse-major-mode-menu): Use local-key-binding.
Dave Love <fx@gnu.org>
parents: 30425
diff changeset
263 (if local-menu
12f2e341ee9c (mouse-major-mode-menu): Use local-key-binding.
Dave Love <fx@gnu.org>
parents: 30425
diff changeset
264 (list local-menu))
12f2e341ee9c (mouse-major-mode-menu): Use local-key-binding.
Dave Love <fx@gnu.org>
parents: 30425
diff changeset
265 minor-mode-menus)
30421
544a9b8ebb8d (popup-menu): Run the keymap through indirect-function,
Eli Zaretskii <eliz@gnu.org>
parents: 30328
diff changeset
266 event prefix)))
30328
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
267
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
268 (defun mouse-popup-menubar-stuff (event prefix)
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
269 "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'.
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
270 Use the former if the menu bar is showing, otherwise the latter."
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
271 (interactive "@e \nP")
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
272 (if (zerop (assoc-default 'menu-bar-lines (frame-parameters) 'eq 0))
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
273 (mouse-popup-menubar event prefix)
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
274 (mouse-major-mode-menu event prefix)))
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
275
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
276 ;; Commands that operate on windows.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
277
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
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>
parents: 6231
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>
parents: 6231
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>
parents: 6231
diff changeset
281 (not (minibuffer-window-active-p w))
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
282 (error "Minibuffer window is not active")))
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
283 ;; Give temporary modes such as isearch a chance to turn off.
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
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>
parents: 6231
diff changeset
285
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
286 (defun mouse-delete-window (click)
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
287 "Delete the window you click on.
38763
3cf8f8ea6d0e (mouse-delete-window): Do nothing if frame has just
Gerd Moellmann <gerd@gnu.org>
parents: 37741
diff changeset
288 Do nothing if the frame has just one window.
22845
bd706438b50c (mouse-delete-window): If the frame has just one window,
Richard M. Stallman <rms@gnu.org>
parents: 21953
diff changeset
289 This command must be bound to a mouse click."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
290 (interactive "e")
38763
3cf8f8ea6d0e (mouse-delete-window): Do nothing if frame has just
Gerd Moellmann <gerd@gnu.org>
parents: 37741
diff changeset
291 (unless (one-window-p t)
22845
bd706438b50c (mouse-delete-window): If the frame has just one window,
Richard M. Stallman <rms@gnu.org>
parents: 21953
diff changeset
292 (mouse-minibuffer-check click)
bd706438b50c (mouse-delete-window): If the frame has just one window,
Richard M. Stallman <rms@gnu.org>
parents: 21953
diff changeset
293 (delete-window (posn-window (event-start click)))))
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
294
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
295 (defun mouse-select-window (click)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
296 "Select the window clicked on; don't move point."
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
297 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
298 (mouse-minibuffer-check click)
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
299 (let ((oframe (selected-frame))
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
300 (frame (window-frame (posn-window (event-start click)))))
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
301 (select-window (posn-window (event-start click)))
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
302 (raise-frame frame)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
303 (select-frame frame)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
304 (or (eq frame oframe)
16087
26b552f014ff (mouse-select-window): Don't call unfocus-frame.
Richard M. Stallman <rms@gnu.org>
parents: 16016
diff changeset
305 (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
306
1421
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
307 (defun mouse-tear-off-window (click)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
308 "Delete the window clicked on, and create a new frame displaying its buffer."
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
309 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
310 (mouse-minibuffer-check click)
1421
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
311 (let* ((window (posn-window (event-start click)))
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
312 (buf (window-buffer window))
7363
f35fe65c9755 (mouse-tear-off-window): Change new-frame to make-frame.
Karl Heuer <kwzh@gnu.org>
parents: 7302
diff changeset
313 (frame (make-frame)))
1421
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
314 (select-frame frame)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
315 (switch-to-buffer buf)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
316 (delete-window window)))
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
317
1363
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
318 (defun mouse-delete-other-windows ()
37741
7b449aec29d2 (mouse-delete-other-windows): Doc fix.
Gerd Moellmann <gerd@gnu.org>
parents: 36134
diff changeset
319 "Delete all windows except the one you click on."
1363
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
320 (interactive "@")
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 (delete-other-windows))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
323 (defun mouse-split-window-vertically (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
324 "Select Emacs window mouse is on, then split it vertically in half.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
325 The window is split at the line clicked on.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
326 This command must be bound to a mouse click."
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
327 (interactive "@e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
328 (mouse-minibuffer-check click)
1363
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
329 (let ((start (event-start click)))
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
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>
parents: 7593
diff changeset
331 (let ((new-height (1+ (cdr (posn-col-row (event-end click)))))
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
332 (first-line window-min-height)
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
333 (last-line (- (window-height) window-min-height)))
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
334 (if (< last-line first-line)
8426
3abe02e03dc8 Capitalize some error messages.
Richard M. Stallman <rms@gnu.org>
parents: 8381
diff changeset
335 (error "Window too short to split")
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
336 (split-window-vertically
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
337 (min (max new-height first-line) last-line))))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
339 (defun mouse-split-window-horizontally (click)
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
340 "Select Emacs window mouse is on, then split it horizontally in half.
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
341 The window is split at the column clicked on.
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
342 This command must be bound to a mouse click."
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
343 (interactive "@e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
344 (mouse-minibuffer-check click)
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
345 (let ((start (event-start click)))
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
346 (select-window (posn-window start))
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
347 (let ((new-width (1+ (car (posn-col-row (event-end click)))))
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
348 (first-col window-min-width)
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
349 (last-col (- (window-width) window-min-width)))
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
350 (if (< last-col first-col)
8426
3abe02e03dc8 Capitalize some error messages.
Richard M. Stallman <rms@gnu.org>
parents: 8381
diff changeset
351 (error "Window too narrow to split")
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
352 (split-window-horizontally
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
353 (min (max new-width first-col) last-col))))))
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
354
42399
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
355 (defun mouse-drag-window-above (window)
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
356 "Return the (or a) window directly above WINDOW.
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
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>
parents: 67870
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>
parents: 67870
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>
parents: 67870
diff changeset
360 (start-right (nth 2 (window-edges window)))
42399
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
361 (start-window window)
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
362 above-window)
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
363 (setq window (previous-window window 0))
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
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>
parents: 67870
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>
parents: 67870
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>
parents: 67870
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>
parents: 67870
diff changeset
368 start-top)
f223df02d351 (mouse-drag-window-above): Verify that the found window overlaps with the
Eli Zaretskii <eliz@gnu.org>
parents: 67870
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>
parents: 67870
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>
parents: 67870
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>
parents: 67870
diff changeset
372 (setq above-window window)))
42399
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
373 (setq window (previous-window window)))
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
374 above-window))
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
375
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
376 (defun mouse-drag-move-window-bottom (window growth)
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
377 "Move the bottom of WINDOW up or down by GROWTH lines.
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
378 Move it down if GROWTH is positive, or up if GROWTH is negative.
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
379 If this would make WINDOW too short,
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
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>
parents: 66669
diff changeset
381 (condition-case nil
2c91c2e7af3a (mouse-drag-move-window-bottom): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 66669
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>
parents: 66669
diff changeset
383 (error nil)))
42399
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
384
57569
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
385 (defsubst mouse-drag-move-window-top (window growth)
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
386 "Move the top of WINDOW up or down by GROWTH lines.
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
387 Move it down if GROWTH is positive, or up if GROWTH is negative.
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
388 If this would make WINDOW too short, shrink the window or windows
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
389 above it to make room."
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
390 ;; Moving the top of WINDOW is actually moving the bottom of the
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
391 ;; window above.
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
392 (let ((window-above (mouse-drag-window-above window)))
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
393 (and window-above
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
394 (mouse-drag-move-window-bottom window-above (- growth)))))
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
395
25618
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
396 (defun mouse-drag-mode-line-1 (start-event mode-line-p)
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
397 "Change the height of a window by dragging on the mode or header line.
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
398 START-EVENT is the starting mouse-event of the drag action.
42399
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
399 MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
400 ;; Give temporary modes such as isearch a chance to turn off.
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
401 (run-hooks 'mouse-leave-buffer-hook)
32207
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
402 (let* ((done nil)
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
403 (echo-keystrokes 0)
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
404 (start (event-start start-event))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
405 (start-event-window (posn-window start))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
406 (start-event-frame (window-frame start-event-window))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
407 (start-nwindows (count-windows t))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
408 (minibuffer (frame-parameter nil 'minibuffer))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
409 should-enlarge-minibuffer event mouse y top bot edges wconfig growth)
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
410 (track-mouse
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
411 (progn
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
412 ;; enlarge-window only works on the selected window, so
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
413 ;; we must select the window where the start event originated.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
414 ;; unwind-protect will restore the old selected window later.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
415 (select-window start-event-window)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
416
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
417 ;; if this is the bottommost ordinary window, then to
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
418 ;; move its modeline the minibuffer must be enlarged.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
419 (setq should-enlarge-minibuffer
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
420 (and minibuffer
25618
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
421 mode-line-p
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
422 (not (one-window-p t))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
423 (= (nth 1 (window-edges minibuffer))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
424 (nth 3 (window-edges)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
425
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
426 ;; loop reading events and sampling the position of
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
427 ;; the mouse.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
428 (while (not done)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
429 (setq event (read-event)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
430 mouse (mouse-position))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
431
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
432 ;; do nothing if
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
433 ;; - there is a switch-frame event.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
434 ;; - the mouse isn't in the frame that we started in
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
435 ;; - the mouse isn't in any Emacs frame
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
436 ;; drag if
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
437 ;; - there is a mouse-movement event
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
438 ;; - there is a scroll-bar-movement event
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
439 ;; (same as mouse movement for our purposes)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
440 ;; quit if
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
441 ;; - there is a keyboard event or some other unknown event
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
442 ;; unknown event.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
443 (cond ((integerp event)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
444 (setq done t))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
445
59470
f009f3970cd9 (mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59128
diff changeset
446 ((memq (car event) '(switch-frame select-window))
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
447 nil)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
448
32207
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
449 ((not (memq (car event) '(mouse-movement scroll-bar-movement)))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
450 (when (consp event)
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
451 (push event unread-command-events))
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
452 (setq done t))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
453
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
454 ((not (eq (car mouse) start-event-frame))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
455 nil)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
456
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
457 ((null (car (cdr mouse)))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
458 nil)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
459
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
460 (t
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
461 (setq y (cdr (cdr mouse))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
462 edges (window-edges)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
463 top (nth 1 edges)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
464 bot (nth 3 edges))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
465
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
466 ;; compute size change needed
25618
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
467 (cond (mode-line-p
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
468 (setq growth (- y bot -1)))
32269
5bccbf00889a (mouse-drag-mode-line-1): Fix an off-by-one error in
Eli Zaretskii <eliz@gnu.org>
parents: 32207
diff changeset
469 (t ; header line
5bccbf00889a (mouse-drag-mode-line-1): Fix an off-by-one error in
Eli Zaretskii <eliz@gnu.org>
parents: 32207
diff changeset
470 (when (< (- bot y) window-min-height)
5bccbf00889a (mouse-drag-mode-line-1): Fix an off-by-one error in
Eli Zaretskii <eliz@gnu.org>
parents: 32207
diff changeset
471 (setq y (- bot window-min-height)))
5bccbf00889a (mouse-drag-mode-line-1): Fix an off-by-one error in
Eli Zaretskii <eliz@gnu.org>
parents: 32207
diff changeset
472 ;; The window's top includes the header line!
5bccbf00889a (mouse-drag-mode-line-1): Fix an off-by-one error in
Eli Zaretskii <eliz@gnu.org>
parents: 32207
diff changeset
473 (setq growth (- top y))))
25618
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
474 (setq wconfig (current-window-configuration))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
475
16636
ba78d234fe6c (mouse-drag-mode-line): Don't get error
Richard M. Stallman <rms@gnu.org>
parents: 16621
diff changeset
476 ;; Check for an error case.
32207
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
477 (when (and (/= growth 0)
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
478 (not minibuffer)
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
479 (one-window-p t))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
480 (error "Attempt to resize sole window"))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
481
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
482 ;; grow/shrink minibuffer?
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
483 (if should-enlarge-minibuffer
68858
bb38a98ef7ad (mouse-drag-mode-line-1): Use mouse-drag-move-window-bottom
Richard M. Stallman <rms@gnu.org>
parents: 68734
diff changeset
484 (unless resize-mini-windows
bb38a98ef7ad (mouse-drag-mode-line-1): Use mouse-drag-move-window-bottom
Richard M. Stallman <rms@gnu.org>
parents: 68734
diff changeset
485 (mouse-drag-move-window-bottom start-event-window growth))
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
486 ;; no. grow/shrink the selected window
32207
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
487 ;(message "growth = %d" growth)
57569
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
488 (if mode-line-p
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
489 (mouse-drag-move-window-bottom start-event-window growth)
f2e8ab894ad3 (mouse-drag-move-window-top): New function.
David Ponce <david@dponce.com>
parents: 57524
diff changeset
490 (mouse-drag-move-window-top start-event-window growth)))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
491
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
492 ;; if this window's growth caused another
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
493 ;; window to be deleted because it was too
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
494 ;; short, rescind the change.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
495 ;;
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
496 ;; if size change caused space to be stolen
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
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>
parents: 30122
diff changeset
498 ;; change, but only if we didn't grow/shrink
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
499 ;; the minibuffer. minibuffer size changes
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
500 ;; can cause all windows to shrink... no way
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
501 ;; around it.
32207
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
502 (when (or (/= start-nwindows (count-windows t))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
503 (and (not should-enlarge-minibuffer)
42399
92c21a38c096 (mouse-drag-mode-line-1): When dragging a mode line upward,
Richard M. Stallman <rms@gnu.org>
parents: 42149
diff changeset
504 (> growth 0)
32207
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
505 mode-line-p
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
506 (/= top (nth 1 (window-edges)))))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
507 (set-window-configuration wconfig)))))))))
25618
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
508
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
509 (defun mouse-drag-mode-line (start-event)
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
510 "Change the height of a window by dragging on the mode line."
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
511 (interactive "e")
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
512 (mouse-drag-mode-line-1 start-event t))
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
513
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
514 (defun mouse-drag-header-line (start-event)
32207
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
515 "Change the height of a window by dragging on the header line.
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
516 Windows whose header-lines are at the top of the frame cannot be
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
517 resized by dragging their header-line."
25618
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
518 (interactive "e")
32207
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
519 ;; Changing the window's size by dragging its header-line when the
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
520 ;; header-line is at the top of the frame is somewhat strange,
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
521 ;; because the header-line doesn't move, so don't do it.
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
522 (let* ((start (event-start start-event))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
523 (window (posn-window start))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
524 (frame (window-frame window))
03dee1b8a506 (mouse-drag-header-line): Don't allow window resizing
Gerd Moellmann <gerd@gnu.org>
parents: 31923
diff changeset
525 (first-window (frame-first-window frame)))
65349
3607a394b655 *** empty log message ***
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
526 (unless (or (eq window first-window)
3607a394b655 *** empty log message ***
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
527 (= (nth 1 (window-edges window))
3607a394b655 *** empty log message ***
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
528 (nth 1 (window-edges first-window))))
3607a394b655 *** empty log message ***
Chong Yidong <cyd@stupidchicken.com>
parents: 64762
diff changeset
529 (mouse-drag-mode-line-1 start-event nil))))
25618
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
530
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
531
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
532 (defun mouse-drag-vertical-line (start-event)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
533 "Change the width of a window by dragging on the vertical line."
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
534 (interactive "e")
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
535 ;; Give temporary modes such as isearch a chance to turn off.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
536 (run-hooks 'mouse-leave-buffer-hook)
20686
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
537 (let* ((done nil)
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
538 (echo-keystrokes 0)
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
539 (start-event-frame (window-frame (car (car (cdr start-event)))))
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
540 (start-event-window (car (car (cdr start-event))))
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
541 (start-nwindows (count-windows t))
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
542 event mouse x left right edges wconfig growth
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
543 (which-side
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
544 (or (cdr (assq 'vertical-scroll-bars (frame-parameters start-event-frame)))
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
545 'right)))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
546 (if (one-window-p t)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
547 (error "Attempt to resize sole ordinary window"))
23854
cb2244476b40 (mouse-drag-vertical-line):
Karl Heuer <kwzh@gnu.org>
parents: 23619
diff changeset
548 (if (eq which-side 'right)
cb2244476b40 (mouse-drag-vertical-line):
Karl Heuer <kwzh@gnu.org>
parents: 23619
diff changeset
549 (if (= (nth 2 (window-edges start-event-window))
cb2244476b40 (mouse-drag-vertical-line):
Karl Heuer <kwzh@gnu.org>
parents: 23619
diff changeset
550 (frame-width start-event-frame))
cb2244476b40 (mouse-drag-vertical-line):
Karl Heuer <kwzh@gnu.org>
parents: 23619
diff changeset
551 (error "Attempt to drag rightmost scrollbar"))
cb2244476b40 (mouse-drag-vertical-line):
Karl Heuer <kwzh@gnu.org>
parents: 23619
diff changeset
552 (if (= (nth 0 (window-edges start-event-window)) 0)
cb2244476b40 (mouse-drag-vertical-line):
Karl Heuer <kwzh@gnu.org>
parents: 23619
diff changeset
553 (error "Attempt to drag leftmost scrollbar")))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
554 (track-mouse
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
555 (progn
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
556 ;; enlarge-window only works on the selected window, so
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
557 ;; we must select the window where the start event originated.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
558 ;; unwind-protect will restore the old selected window later.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
559 (select-window start-event-window)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
560 ;; loop reading events and sampling the position of
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
561 ;; the mouse.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
562 (while (not done)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
563 (setq event (read-event)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
564 mouse (mouse-position))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
565 ;; do nothing if
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
566 ;; - there is a switch-frame event.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
567 ;; - the mouse isn't in the frame that we started in
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
568 ;; - the mouse isn't in any Emacs frame
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
569 ;; drag if
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
570 ;; - there is a mouse-movement event
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
571 ;; - there is a scroll-bar-movement event
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
572 ;; (same as mouse movement for our purposes)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
573 ;; quit if
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
574 ;; - there is a keyboard event or some other unknown event
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
575 ;; unknown event.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
576 (cond ((integerp event)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
577 (setq done t))
59470
f009f3970cd9 (mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59128
diff changeset
578 ((memq (car event) '(switch-frame select-window))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
579 nil)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
580 ((not (memq (car event)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
581 '(mouse-movement scroll-bar-movement)))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
582 (if (consp event)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
583 (setq unread-command-events
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
584 (cons event unread-command-events)))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
585 (setq done t))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
586 ((not (eq (car mouse) start-event-frame))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
587 nil)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
588 ((null (car (cdr mouse)))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
589 nil)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
590 (t
67524
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
591 (let ((window
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
592 ;; If the scroll bar is on the window's left,
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
593 ;; adjust the window on the left.
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
594 (if (eq which-side 'right)
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
595 (selected-window)
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
596 (previous-window))))
20124
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
597 (setq x (- (car (cdr mouse))
23854
cb2244476b40 (mouse-drag-vertical-line):
Karl Heuer <kwzh@gnu.org>
parents: 23619
diff changeset
598 (if (eq which-side 'right) 0 2))
67524
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
599 edges (window-edges window)
20124
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
600 left (nth 0 edges)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
601 right (nth 2 edges))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
602 ;; scale back a move that would make the
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
603 ;; window too thin.
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
604 (if (< (- x left -1) window-min-width)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
605 (setq x (+ left window-min-width -1)))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
606 ;; compute size change needed
67524
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
607 (setq growth (- x right -1))
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
608 (condition-case nil
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
609 (adjust-window-trailing-edge window growth t)
9014ad13a926 (mouse-drag-vertical-line): Use adjust-window-trailing-edge.
Richard M. Stallman <rms@gnu.org>
parents: 67158
diff changeset
610 (error nil))))))))))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
611
4554
cf541ed1fed8 (mouse-set-point): Use event-end, not event-start.
Richard M. Stallman <rms@gnu.org>
parents: 4532
diff changeset
612 (defun mouse-set-point (event)
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
613 "Move point to the position clicked on with the mouse.
4554
cf541ed1fed8 (mouse-set-point): Use event-end, not event-start.
Richard M. Stallman <rms@gnu.org>
parents: 4532
diff changeset
614 This should be bound to a mouse click event type."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
615 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
616 (mouse-minibuffer-check event)
4554
cf541ed1fed8 (mouse-set-point): Use event-end, not event-start.
Richard M. Stallman <rms@gnu.org>
parents: 4532
diff changeset
617 ;; Use event-end in case called from mouse-drag-region.
cf541ed1fed8 (mouse-set-point): Use event-end, not event-start.
Richard M. Stallman <rms@gnu.org>
parents: 4532
diff changeset
618 ;; If EVENT is a click, event-end and event-start give same value.
54867
c59162a8d0f8 (mouse-set-point): Use it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 53133
diff changeset
619 (posn-set-point (event-end event)))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
620
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
621 (defvar mouse-last-region-beg nil)
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
622 (defvar mouse-last-region-end nil)
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
623 (defvar mouse-last-region-tick nil)
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
624
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
625 (defun mouse-region-match ()
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
626 "Return non-nil if there's an active region that was set with the mouse."
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
627 (and (mark t) mark-active
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
628 (eq mouse-last-region-beg (region-beginning))
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
629 (eq mouse-last-region-end (region-end))
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
630 (eq mouse-last-region-tick (buffer-modified-tick))))
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
631
1420
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
632 (defun mouse-set-region (click)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
633 "Set the region to the text dragged over, and copy to kill ring.
4554
cf541ed1fed8 (mouse-set-point): Use event-end, not event-start.
Richard M. Stallman <rms@gnu.org>
parents: 4532
diff changeset
634 This should be bound to a mouse drag event."
1420
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
635 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
636 (mouse-minibuffer-check click)
1420
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
637 (let ((posn (event-start click))
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
638 (end (event-end click)))
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
639 (select-window (posn-window posn))
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
640 (if (numberp (posn-point posn))
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
641 (goto-char (posn-point posn)))
2799
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
642 ;; If mark is highlighted, no need to bounce the cursor.
12078
eb9f9e9cd522 (mouse-set-region): Don't bounce the cursor on X.
Karl Heuer <kwzh@gnu.org>
parents: 11863
diff changeset
643 ;; On X, we highlight while dragging, thus once again no need to bounce.
eb9f9e9cd522 (mouse-set-region): Don't bounce the cursor on X.
Karl Heuer <kwzh@gnu.org>
parents: 11863
diff changeset
644 (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>
parents: 66123
diff changeset
645 (memq (framep (selected-frame)) '(x pc w32 mac))
2799
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
646 (sit-for 1))
1420
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
647 (push-mark)
2802
02c75b605550 (mouse-set-region): Call set-mark to activate mark.
Richard M. Stallman <rms@gnu.org>
parents: 2799
diff changeset
648 (set-mark (point))
1420
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
649 (if (numberp (posn-point end))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
650 (goto-char (posn-point end)))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
651 ;; Don't set this-command to kill-region, so that a following
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
652 ;; C-w will not double the text in the kill ring.
12257
29b6db180047 (mouse-set-region): Bind last-command with this-command.
Richard M. Stallman <rms@gnu.org>
parents: 12078
diff changeset
653 ;; Ignore last-command so we don't append to a preceding kill.
55260
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
654 (when mouse-drag-copy-region
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
655 (let (this-command last-command deactivate-mark)
f547921c38ba (mouse-drag-copy-region): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 54867
diff changeset
656 (copy-region-as-kill (mark) (point))))
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
657 (mouse-set-region-1)))
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
658
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
659 (defun mouse-set-region-1 ()
55803
9070d5f984ea (mouse-set-region-1): Use temporary transient-mark-mode
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55260
diff changeset
660 ;; Set transient-mark-mode for a little while.
56379
72ec8013c5a1 (mouse-set-region-1): If transient-mark-mode
Richard M. Stallman <rms@gnu.org>
parents: 56171
diff changeset
661 (if (memq transient-mark-mode '(nil identity))
72ec8013c5a1 (mouse-set-region-1): If transient-mark-mode
Richard M. Stallman <rms@gnu.org>
parents: 56171
diff changeset
662 (setq transient-mark-mode 'only))
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
663 (setq mouse-last-region-beg (region-beginning))
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
664 (setq mouse-last-region-end (region-end))
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
665 (setq mouse-last-region-tick (buffer-modified-tick)))
1420
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
666
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
667 (defcustom mouse-scroll-delay 0.25
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
668 "*The pause between scroll steps caused by mouse drags, in seconds.
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
669 If you drag the mouse beyond the edge of a window, Emacs scrolls the
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
670 window to bring the text beyond that edge into view, with a delay of
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
671 this many seconds between scroll steps. Scrolling stops when you move
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
672 the mouse back into the window, or release the button.
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
673 This variable's value may be non-integral.
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
674 Setting this to zero causes Emacs to scroll as fast as it can."
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
675 :type 'number
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
676 :group 'mouse)
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
677
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
678 (defcustom mouse-scroll-min-lines 1
13068
9cc4392719e3 [These changes were actually in the previous version.
Richard M. Stallman <rms@gnu.org>
parents: 13038
diff changeset
679 "*The minimum number of lines scrolled by dragging mouse out of window.
9cc4392719e3 [These changes were actually in the previous version.
Richard M. Stallman <rms@gnu.org>
parents: 13038
diff changeset
680 Moving the mouse out the top or bottom edge of the window begins
9cc4392719e3 [These changes were actually in the previous version.
Richard M. Stallman <rms@gnu.org>
parents: 13038
diff changeset
681 scrolling repeatedly. The number of lines scrolled per repetition
9cc4392719e3 [These changes were actually in the previous version.
Richard M. Stallman <rms@gnu.org>
parents: 13038
diff changeset
682 is normally equal to the number of lines beyond the window edge that
9cc4392719e3 [These changes were actually in the previous version.
Richard M. Stallman <rms@gnu.org>
parents: 13038
diff changeset
683 the mouse has moved. However, it always scrolls at least the number
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
684 of lines specified by this variable."
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
685 :type 'integer
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
686 :group 'mouse)
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
687
7932
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
688 (defun mouse-scroll-subr (window jump &optional overlay start)
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
689 "Scroll the window WINDOW, JUMP lines at a time, until new input arrives.
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
690 If OVERLAY is an overlay, let it stretch from START to the far edge of
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
691 the newly visible text.
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
692 Upon exit, point is at the far edge of the newly visible text."
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
693 (cond
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
694 ((and (> jump 0) (< jump mouse-scroll-min-lines))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
695 (setq jump mouse-scroll-min-lines))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
696 ((and (< jump 0) (< (- jump) mouse-scroll-min-lines))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
697 (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>
parents: 7932
diff changeset
698 (let ((opoint (point)))
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
699 (while (progn
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
700 (goto-char (window-start window))
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
701 (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>
parents: 7932
diff changeset
702 (progn
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
703 (set-window-start window (point))
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
704 (if (natnump jump)
21176
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
705 (if (window-end window)
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
706 (progn
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
707 (goto-char (window-end window))
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
708 ;; window-end doesn't reflect the window's new
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
709 ;; start position until the next redisplay.
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
710 (vertical-motion (1- jump) window))
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
711 (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>
parents: 7932
diff changeset
712 (goto-char (window-start window)))
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
713 (if overlay
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
714 (move-overlay overlay start (point)))
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
715 ;; 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>
parents: 7932
diff changeset
716 ;; 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>
parents: 7932
diff changeset
717 ;; 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>
parents: 7932
diff changeset
718 (or (eq window (selected-window))
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
719 (goto-char opoint))
8064
d04a39ce4f1d (mouse-scroll-subr): Don't do anything special at eob.
Richard M. Stallman <rms@gnu.org>
parents: 7966
diff changeset
720 (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>
parents: 7932
diff changeset
721 (or (eq window (selected-window))
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
722 (goto-char opoint))))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
723
11453
5ed0795c4155 Create mouse-drag-overlay as a dead overlay, instead
Karl Heuer <kwzh@gnu.org>
parents: 11235
diff changeset
724 ;; Create an overlay and immediately delete it, to get "overlay in no buffer".
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
725 (defconst mouse-drag-overlay
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
726 (let ((ol (make-overlay (point-min) (point-min))))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
727 (delete-overlay ol)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
728 (overlay-put ol 'face 'region)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
729 ol))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
730
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
731 (defvar mouse-selection-click-count 0)
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
732
12436
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
733 (defvar mouse-selection-click-count-buffer nil)
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
734
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
735 (defun mouse-drag-region (start-event)
2799
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
736 "Set the region to the text that the mouse is dragged over.
4532
c2afed091afb (mouse-drag-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 4490
diff changeset
737 Highlight the drag area as you move the mouse.
c2afed091afb (mouse-drag-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 4490
diff changeset
738 This must be bound to a button-down mouse event.
15116
a152ab5c09b0 (mouse-drag-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 15082
diff changeset
739 In Transient Mark mode, the highlighting remains as long as the mark
42806
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
740 remains active. Otherwise, it remains until the next input event.
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
741
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
742 If the click is in the echo area, display the `*Messages*' buffer."
3566
dc2b64ef30dc (mouse-drag-region-1): Un-comment-out this function.
Richard M. Stallman <rms@gnu.org>
parents: 3420
diff changeset
743 (interactive "e")
59470
f009f3970cd9 (mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59128
diff changeset
744 (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>
parents: 59128
diff changeset
745 (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>
parents: 59128
diff changeset
746 (not (minibuffer-window-active-p w)))
42806
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
747 (save-excursion
59526
d52b0a40bde9 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 59500
diff changeset
748 ;; Swallow the up-event.
42806
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
749 (read-event)
66322
e921fbeaaddb 2005-10-23 MIYOSHI Masanori <miyoshi@meadowy.org> (tiny change)
Romain Francoise <romain@orebokech.com>
parents: 66180
diff changeset
750 (set-buffer (get-buffer-create "*Messages*"))
42806
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
751 (goto-char (point-max))
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
752 (display-buffer (current-buffer)))
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
753 ;; Give temporary modes such as isearch a chance to turn off.
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
754 (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>
parents: 67965
diff changeset
755 (mouse-drag-track start-event t))))
42806
7ec99458ed2e (mouse-drag-region-1): Renamed from mouse-drag-region.
Richard M. Stallman <rms@gnu.org>
parents: 42399
diff changeset
756
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
757
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
758 (defun mouse-on-link-p (pos)
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
759 "Return non-nil if POS is on a link in the current buffer.
60204
074d6632232c (mouse-on-link-p): If arg POS is a mouse event,
Kim F. Storm <storm@cua.dk>
parents: 59996
diff changeset
760 POS must be a buffer position in the current buffer or an mouse
074d6632232c (mouse-on-link-p): If arg POS is a mouse event,
Kim F. Storm <storm@cua.dk>
parents: 59996
diff changeset
761 event location in the selected window, see `event-start'.
60253
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
762 However, if `mouse-1-click-in-non-selected-windows' is non-nil,
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
763 POS may be a mouse event location in any window.
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
764
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
765 A clickable link is identified by one of the following methods:
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
766
59500
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
767 - If the character at POS has a non-nil `follow-link' text or
61376
15f4c9e1a9b2 (mouse-on-link-p): Tiny doc fix.
Kim F. Storm <storm@cua.dk>
parents: 61160
diff changeset
768 overlay property, the value of that property determines what to do.
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
769
59500
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
770 - If there is a local key-binding or a keybinding at position POS
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
771 for the `follow-link' event, the binding of that event determines
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
772 what to do.
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
773
59500
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
774 The resulting value determine whether POS is inside a link:
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
775
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
776 - If the value is `mouse-face', POS is inside a link if there
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
777 is a non-nil `mouse-face' property at POS. Return t in this case.
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
778
59500
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
779 - If the value is a function, FUNC, POS is inside a link if
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
780 the call \(FUNC POS) returns non-nil. Return the return value
60204
074d6632232c (mouse-on-link-p): If arg POS is a mouse event,
Kim F. Storm <storm@cua.dk>
parents: 59996
diff changeset
781 from that call. Arg is \(posn-point POS) if POS is a mouse event,
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
782
59500
e7064c8273f5 More doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 59499
diff changeset
783 - Otherwise, return the value itself.
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
784
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
785 The return value is interpreted as follows:
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
786
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
787 - If it is a string, the mouse-1 event is translated into the
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
788 first character of the string, i.e. the action of the mouse-1
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
789 click is the local or global binding of that character.
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
790
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
791 - If it is a vector, the mouse-1 event is translated into the
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
792 first element of that vector, i.e. the action of the mouse-1
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
793 click is the local or global binding of that event.
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
794
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
795 - Otherwise, the mouse-1 event is translated into a mouse-2 event
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
796 at the same position."
60253
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
797 (let ((w (and (consp pos) (posn-window pos))))
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
798 (if (consp pos)
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
799 (setq pos (and (or mouse-1-click-in-non-selected-windows
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
800 (eq (selected-window) w))
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
801 (posn-point pos))))
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
802 (when pos
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
803 (with-current-buffer (window-buffer w)
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
804 (let ((action
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
805 (or (get-char-property pos 'follow-link)
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
806 (save-excursion
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
807 (goto-char pos)
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
808 (key-binding [follow-link] nil t)))))
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
809 (cond
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
810 ((eq action 'mouse-face)
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
811 (and (get-char-property pos 'mouse-face) t))
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
812 ((functionp action)
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
813 (funcall action pos))
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
814 (t action)))))))
60204
074d6632232c (mouse-on-link-p): If arg POS is a mouse event,
Kim F. Storm <storm@cua.dk>
parents: 59996
diff changeset
815
61160
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
816 (defun mouse-fixup-help-message (msg)
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
817 "Fix help message MSG for `mouse-1-click-follows-link'."
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
818 (let (mp pos)
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
819 (if (and mouse-1-click-follows-link
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
820 (stringp msg)
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
821 (save-match-data
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
822 (string-match "^mouse-2" msg))
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
823 (setq mp (mouse-pixel-position))
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
824 (consp (setq pos (cdr mp)))
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
825 (car pos) (>= (car pos) 0)
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
826 (cdr pos) (>= (cdr pos) 0)
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
827 (setq pos (posn-at-x-y (car pos) (cdr pos) (car mp)))
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
828 (windowp (posn-window pos)))
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
829 (with-current-buffer (window-buffer (posn-window pos))
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
830 (if (mouse-on-link-p pos)
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
831 (setq msg (concat
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
832 (cond
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
833 ((eq mouse-1-click-follows-link 'double) "double-")
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
834 ((and (integerp mouse-1-click-follows-link)
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
835 (< mouse-1-click-follows-link 0)) "Long ")
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
836 (t ""))
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
837 "mouse-1" (substring msg 7)))))))
2bc2e06d78aa (mouse-1-click-follows-link): Increase to 450 ms.
Kim F. Storm <storm@cua.dk>
parents: 60253
diff changeset
838 msg)
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
839
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
840 (defun mouse-move-drag-overlay (ol start end mode)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
841 (unless (= start end)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
842 ;; Go to START first, so that when we move to END, if it's in the middle
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
843 ;; of intangible text, point jumps in the direction away from START.
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
844 ;; Don't do it if START=END otherwise a single click risks selecting
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
845 ;; a region if it's on intangible text. This exception was originally
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
846 ;; only applied on entry to mouse-drag-region, which had the problem
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
847 ;; that a tiny move during a single-click would cause the intangible
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
848 ;; text to be selected.
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
849 (goto-char start)
65651
b16e4baf1a72 (mouse-move-drag-overlay): Fix last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65640
diff changeset
850 (goto-char end)
b16e4baf1a72 (mouse-move-drag-overlay): Fix last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65640
diff changeset
851 (setq end (point)))
b16e4baf1a72 (mouse-move-drag-overlay): Fix last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65640
diff changeset
852 (let ((range (mouse-start-end start end mode)))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
853 (move-overlay ol (car range) (nth 1 range))))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
854
67997
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
855 (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>
parents: 67965
diff changeset
856 do-mouse-drag-region-post-process)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
857 "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>
parents: 67965
diff changeset
858 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>
parents: 67965
diff changeset
859 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>
parents: 67965
diff changeset
860 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>
parents: 6231
diff changeset
861 (mouse-minibuffer-check start-event)
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
862 (setq mouse-selection-click-count-buffer (current-buffer))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
863 (let* ((original-window (selected-window))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
864 ;; We've recorded what we needed from the current buffer and
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
865 ;; window, now let's jump to the place of the event, where things
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
866 ;; are happening.
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
867 (_ (mouse-set-point start-event))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
868 (echo-keystrokes 0)
14179
7db5b89b78b6 (mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
parents: 13872
diff changeset
869 (start-posn (event-start start-event))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
870 (start-point (posn-point start-posn))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
871 (start-window (posn-window start-posn))
41034
edd3baa8e385 (mouse-drag-region): Don't run the up-event
Richard M. Stallman <rms@gnu.org>
parents: 41033
diff changeset
872 (start-window-start (window-start start-window))
28075
7421de9165d2 (mouse-drag-region): Don't run up-event handler
Gerd Moellmann <gerd@gnu.org>
parents: 27834
diff changeset
873 (start-hscroll (window-hscroll start-window))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
874 (bounds (window-edges start-window))
58194
00222ee714ca (mouse-drag-copy-region): Add :version.
Kim F. Storm <storm@cua.dk>
parents: 57927
diff changeset
875 (make-cursor-line-fully-visible nil)
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
876 (top (nth 1 bounds))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
877 (bottom (if (window-minibuffer-p start-window)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
878 (nth 3 bounds)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
879 ;; Don't count the mode line.
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
880 (1- (nth 3 bounds))))
60204
074d6632232c (mouse-on-link-p): If arg POS is a mouse event,
Kim F. Storm <storm@cua.dk>
parents: 59996
diff changeset
881 (on-link (and mouse-1-click-follows-link
60253
6452fdddef8f (mouse-1-click-in-non-selected-windows): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 60204
diff changeset
882 (or mouse-1-click-in-non-selected-windows
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
883 (eq start-window original-window))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
884 ;; Use start-point before the intangibility
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
885 ;; treatment, in case we click on a link inside an
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
886 ;; intangible text.
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
887 (mouse-on-link-p start-point)))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
888 (click-count (1- (event-click-count start-event)))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
889 (remap-double-click (and on-link
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
890 (eq mouse-1-click-follows-link 'double)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
891 (= click-count 1))))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
892 (setq mouse-selection-click-count click-count)
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
893 ;; In case the down click is in the middle of some intangible text,
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
894 ;; use the end of that text, and put it in START-POINT.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
895 (if (< (point) start-point)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
896 (goto-char start-point))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
897 (setq start-point (point))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
898 (if remap-double-click ;; Don't expand mouse overlay in links
59016
1c959d343308 (mouse-1-click-follows-link): New defcustom.
Kim F. Storm <storm@cua.dk>
parents: 58837
diff changeset
899 (setq click-count 0))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
900 (mouse-move-drag-overlay mouse-drag-overlay start-point start-point
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
901 click-count)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
902 (overlay-put mouse-drag-overlay 'window start-window)
4200
3f5f55401364 (mouse-drag-region): Use deactivate-mark.
Richard M. Stallman <rms@gnu.org>
parents: 4081
diff changeset
903 (deactivate-mark)
65623
fcbaf6135d19 (mouse-drag-mode-line-1, mouse-drag-vertical-line):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65498
diff changeset
904 (let (event end end-point last-end-point)
3566
dc2b64ef30dc (mouse-drag-region-1): Un-comment-out this function.
Richard M. Stallman <rms@gnu.org>
parents: 3420
diff changeset
905 (track-mouse
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
906 (while (progn
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
907 (setq event (read-event))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
908 (or (mouse-movement-p event)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
909 (memq (car-safe event) '(switch-frame select-window))))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
910 (if (memq (car-safe event) '(switch-frame select-window))
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
911 nil
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
912 (setq end (event-end event)
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
913 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>
parents: 16201
diff changeset
914 (if (numberp end-point)
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
915 (setq last-end-point end-point))
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
916
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
917 (cond
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
918 ;; Are we moving within the original window?
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
919 ((and (eq (posn-window end) start-window)
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
920 (integer-or-marker-p end-point))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
921 (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
922
6923
5df81bebf7f7 (mouse-drag-region): Handle scroll off top/bottom.
Karl Heuer <kwzh@gnu.org>
parents: 6914
diff changeset
923 (t
5df81bebf7f7 (mouse-drag-region): Handle scroll off top/bottom.
Karl Heuer <kwzh@gnu.org>
parents: 6914
diff changeset
924 (let ((mouse-row (cdr (cdr (mouse-position)))))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
925 (cond
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
926 ((null mouse-row))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
927 ((< mouse-row top)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
928 (mouse-scroll-subr start-window (- mouse-row top)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
929 mouse-drag-overlay start-point))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
930 ((>= mouse-row bottom)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
931 (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
932 mouse-drag-overlay start-point)))))))))
41611
64ee9a4a698e Converted backquote to the new style (in comments).
Sam Steingold <sds@gnu.org>
parents: 41034
diff changeset
933
23611
4c8718a0fb85 (mouse-drag-region): Fake up a mouse-motion event
Richard M. Stallman <rms@gnu.org>
parents: 22852
diff changeset
934 ;; In case we did not get a mouse-motion event
4c8718a0fb85 (mouse-drag-region): Fake up a mouse-motion event
Richard M. Stallman <rms@gnu.org>
parents: 22852
diff changeset
935 ;; for the final move of the mouse before a drag event
4c8718a0fb85 (mouse-drag-region): Fake up a mouse-motion event
Richard M. Stallman <rms@gnu.org>
parents: 22852
diff changeset
936 ;; pretend that we did get one.
4c8718a0fb85 (mouse-drag-region): Fake up a mouse-motion event
Richard M. Stallman <rms@gnu.org>
parents: 22852
diff changeset
937 (when (and (memq 'drag (event-modifiers (car-safe event)))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
938 (setq end (event-end event)
23611
4c8718a0fb85 (mouse-drag-region): Fake up a mouse-motion event
Richard M. Stallman <rms@gnu.org>
parents: 22852
diff changeset
939 end-point (posn-point end))
4c8718a0fb85 (mouse-drag-region): Fake up a mouse-motion event
Richard M. Stallman <rms@gnu.org>
parents: 22852
diff changeset
940 (eq (posn-window end) start-window)
4c8718a0fb85 (mouse-drag-region): Fake up a mouse-motion event
Richard M. Stallman <rms@gnu.org>
parents: 22852
diff changeset
941 (integer-or-marker-p end-point))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
942 (mouse-move-drag-overlay mouse-drag-overlay start-point end-point click-count))
23611
4c8718a0fb85 (mouse-drag-region): Fake up a mouse-motion event
Richard M. Stallman <rms@gnu.org>
parents: 22852
diff changeset
943
67997
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
944 ;; Handle the terminating event
7966
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
945 (if (consp event)
66085
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
946 (let* ((fun (key-binding (vector (car event))))
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
947 (do-multi-click (and (> (event-click-count event) 0)
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
948 (functionp fun)
67997
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
949 (not (memq fun
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
950 '(mouse-set-point
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
951 mouse-set-region))))))
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
952 ;; Run the binding of the terminating up-event, if possible.
66085
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
953 (if (and (not (= (overlay-start mouse-drag-overlay)
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
954 (overlay-end mouse-drag-overlay)))
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
955 (not do-multi-click))
18459
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
956 (let* ((stop-point
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
957 (if (numberp (posn-point (event-end event)))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
958 (posn-point (event-end event))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
959 last-end-point))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
960 ;; The end that comes from where we ended the drag.
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
961 ;; Point goes here.
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
962 (region-termination
67997
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
963 (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>
parents: 67965
diff changeset
964 (overlay-start mouse-drag-overlay)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
965 (overlay-end mouse-drag-overlay)))
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
966 ;; 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>
parents: 67965
diff changeset
967 ;; Mark goes there.
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
968 (region-commencement
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
969 (- (+ (overlay-end mouse-drag-overlay)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
970 (overlay-start mouse-drag-overlay))
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
971 region-termination))
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
972 last-command this-command)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
973 (push-mark region-commencement t t)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
974 (goto-char region-termination)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
975 (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>
parents: 67965
diff changeset
976 ;; 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>
parents: 67965
diff changeset
977 (delete-overlay mouse-drag-overlay)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
978 ;; 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>
parents: 67965
diff changeset
979 (when mouse-drag-copy-region
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
980 (let (deactivate-mark)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
981 (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>
parents: 67965
diff changeset
982 (let ((buffer (current-buffer)))
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
983 (mouse-show-mark)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
984 ;; 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>
parents: 67965
diff changeset
985 ;; 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>
parents: 67965
diff changeset
986 ;; under us. If that happened,
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
987 ;; avoid trying to use the region.
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
988 (and (mark t) mark-active
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
989 (eq buffer (current-buffer))
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
990 (mouse-set-region-1)))))
66085
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
991 ;; Run the binding of the terminating up-event.
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
992 ;; If a multiple click is not bound to mouse-set-point,
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
993 ;; cancel the effects of mouse-move-drag-overlay to
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
994 ;; avoid producing wrong results.
bff53f7b277b * mouse.el (mouse-drag-region-1): Handle the case where a
Chong Yidong <cyd@stupidchicken.com>
parents: 66021
diff changeset
995 (if do-multi-click (goto-char start-point))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
996 (delete-overlay mouse-drag-overlay)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
997 (when (and (functionp fun)
67997
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
998 (= start-hscroll (window-hscroll start-window))
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
999 ;; 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>
parents: 67965
diff changeset
1000 ;; 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>
parents: 67965
diff changeset
1001 ;; 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>
parents: 67965
diff changeset
1002 ;; 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>
parents: 67965
diff changeset
1003 ;; 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>
parents: 67965
diff changeset
1004 ;; 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>
parents: 67965
diff changeset
1005 ;; 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>
parents: 67965
diff changeset
1006 ;; and point is set again.
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
1007 (or end-point
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
1008 (= (window-start start-window)
217b260efd66 (mouse-drag-track): Renamed, from `mouse-drag-region-1'. Includes
J.D. Smith <jdsmith@as.arizona.edu>
parents: 67965
diff changeset
1009 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>
parents: 67779
diff changeset
1010 (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>
parents: 67779
diff changeset
1011 (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>
parents: 67779
diff changeset
1012 (consp event)
60b2bb5ad00f (mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
parents: 67779
diff changeset
1013 (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>
parents: 67779
diff changeset
1014 (and
60b2bb5ad00f (mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
parents: 67779
diff changeset
1015 (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>
parents: 67779
diff changeset
1016 (= click-count 0)
60b2bb5ad00f (mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
Richard M. Stallman <rms@gnu.org>
parents: 67779
diff changeset
1017 (= (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>
parents: 67779
diff changeset
1018 (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>
parents: 67779
diff changeset
1019 (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>
parents: 67779
diff changeset
1020 (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>
parents: 67779
diff changeset
1021 (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>
parents: 67779
diff changeset
1022 (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>
parents: 67779
diff changeset
1023 (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>
parents: 67779
diff changeset
1024 (<= (- 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>
parents: 67779
diff changeset
1025 (< (- t0 t1) mouse-1-click-follows-link))))))))
68734
43f8bbedb5ee 2006-02-08 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 68651
diff changeset
1026 ;; 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>
parents: 67779
diff changeset
1027 ;; 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>
parents: 67779
diff changeset
1028 ;; 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>
parents: 67779
diff changeset
1029 ;; 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>
parents: 67779
diff changeset
1030 (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>
parents: 67779
diff changeset
1031 (setq event (aref on-link 0))
68734
43f8bbedb5ee 2006-02-08 Chong Yidong <cyd@stupidchicken.com>
Chong Yidong <cyd@stupidchicken.com>
parents: 68651
diff changeset
1032 (select-window original-window)
67965
ea7ab3ce03e8 (mouse-drag-region-1): When following link via mouse-2,
Richard M. Stallman <rms@gnu.org>
parents: 67954
diff changeset
1033 (setcar event 'mouse-2)
ea7ab3ce03e8 (mouse-drag-region-1): When following link via mouse-2,
Richard M. Stallman <rms@gnu.org>
parents: 67954
diff changeset
1034 ;; If this mouse click has never been done by
ea7ab3ce03e8 (mouse-drag-region-1): When following link via mouse-2,
Richard M. Stallman <rms@gnu.org>
parents: 67954
diff changeset
1035 ;; the user, it doesn't have the necessary
ea7ab3ce03e8 (mouse-drag-region-1): When following link via mouse-2,
Richard M. Stallman <rms@gnu.org>
parents: 67954
diff changeset
1036 ;; property to be interpreted correctly.
ea7ab3ce03e8 (mouse-drag-region-1): When following link via mouse-2,
Richard M. Stallman <rms@gnu.org>
parents: 67954
diff changeset
1037 (put 'mouse-2 'event-kind 'mouse-click)))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1038 (push event unread-command-events))))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1039
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1040 ;; Case where the end-event is not a cons cell (it's just a boring
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1041 ;; char-key-press).
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
1042 (delete-overlay mouse-drag-overlay)))))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1043
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1044 ;; Commands to handle xterm-style multiple clicks.
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1045 (defun mouse-skip-word (dir)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1046 "Skip over word, over whitespace, or over identical punctuation.
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1047 If DIR is positive skip forward; if negative, skip backward."
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1048 (let* ((char (following-char))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1049 (syntax (char-to-string (char-syntax char))))
22852
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1050 (cond ((string= syntax "w")
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1051 ;; Here, we can't use skip-syntax-forward/backward because
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1052 ;; they don't pay attention to word-separating-categories,
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1053 ;; and thus they will skip over a true word boundary. So,
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1054 ;; we simularte the original behaviour by using
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1055 ;; forward-word.
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1056 (if (< dir 0)
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1057 (if (not (looking-at "\\<"))
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1058 (forward-word -1))
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1059 (if (or (looking-at "\\<") (not (looking-at "\\>")))
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1060 (forward-word 1))))
dfb255fb91c8 (mouse-skip-word): If point is at word constituent
Kenichi Handa <handa@m17n.org>
parents: 22845
diff changeset
1061 ((string= syntax " ")
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1062 (if (< dir 0)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1063 (skip-syntax-backward syntax)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1064 (skip-syntax-forward syntax)))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1065 ((string= syntax "_")
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1066 (if (< dir 0)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1067 (skip-syntax-backward "w_")
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1068 (skip-syntax-forward "w_")))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1069 ((< dir 0)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1070 (while (and (not (bobp)) (= (preceding-char) char))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1071 (forward-char -1)))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1072 (t
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1073 (while (and (not (eobp)) (= (following-char) char))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
1074 (forward-char 1))))))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
1075
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
1076 (defun mouse-start-end (start end mode)
66669
550c8e306cb5 Fix special handling of DEL after dragging a region:
Richard M. Stallman <rms@gnu.org>
parents: 66322
diff changeset
1077 "Return a list of region bounds based on START and END according to MODE.
52405
970694efa9b5 (mouse-popup-menubar, mouse-skip-word): Doc fix.
Dave Love <fx@gnu.org>
parents: 52401
diff changeset
1078 If MODE is 0 then set point to (min START END), mark to (max START END).
970694efa9b5 (mouse-popup-menubar, mouse-skip-word): Doc fix.
Dave Love <fx@gnu.org>
parents: 52401
diff changeset
1079 If MODE is 1 then set point to start of word at (min START END),
970694efa9b5 (mouse-popup-menubar, mouse-skip-word): Doc fix.
Dave Love <fx@gnu.org>
parents: 52401
diff changeset
1080 mark to end of word at (max START END).
970694efa9b5 (mouse-popup-menubar, mouse-skip-word): Doc fix.
Dave Love <fx@gnu.org>
parents: 52401
diff changeset
1081 If MODE is 2 then do the same for lines."
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1082 (if (> start end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1083 (let ((temp start))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1084 (setq start end
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1085 end temp)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1086 (setq mode (mod mode 3))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1087 (cond ((= mode 0)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1088 (list start end))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1089 ((and (= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1090 (= start end)
5869
91dcabd87088 (mouse-start-end): Check START rather than point for being at eob.
Karl Heuer <kwzh@gnu.org>
parents: 5799
diff changeset
1091 (char-after start)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1092 (= (char-syntax (char-after start)) ?\())
5879
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
1093 (list start
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
1094 (save-excursion
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
1095 (goto-char start)
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
1096 (forward-sexp 1)
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
1097 (point))))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1098 ((and (= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1099 (= start end)
5869
91dcabd87088 (mouse-start-end): Check START rather than point for being at eob.
Karl Heuer <kwzh@gnu.org>
parents: 5799
diff changeset
1100 (char-after start)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1101 (= (char-syntax (char-after start)) ?\)))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1102 (list (save-excursion
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1103 (goto-char (1+ start))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1104 (backward-sexp 1)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1105 (point))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1106 (1+ start)))
15561
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1107 ((and (= mode 1)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1108 (= start end)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1109 (char-after start)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1110 (= (char-syntax (char-after start)) ?\"))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1111 (let ((open (or (eq start (point-min))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1112 (save-excursion
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1113 (goto-char (- start 1))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1114 (looking-at "\\s(\\|\\s \\|\\s>")))))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1115 (if open
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1116 (list start
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1117 (save-excursion
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1118 (condition-case nil
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1119 (progn
15561
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1120 (goto-char start)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1121 (forward-sexp 1)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1122 (point))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1123 (error end))))
16746
9d2a854bac89 (mouse-start-end): Put values in proper order,
Richard M. Stallman <rms@gnu.org>
parents: 16636
diff changeset
1124 (list (save-excursion
15561
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1125 (condition-case nil
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1126 (progn
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1127 (goto-char (1+ start))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1128 (backward-sexp 1)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
1129 (point))
16746
9d2a854bac89 (mouse-start-end): Put values in proper order,
Richard M. Stallman <rms@gnu.org>
parents: 16636
diff changeset
1130 (error end)))
9d2a854bac89 (mouse-start-end): Put values in proper order,
Richard M. Stallman <rms@gnu.org>
parents: 16636
diff changeset
1131 (1+ start)))))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1132 ((= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1133 (list (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1134 (goto-char start)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1135 (mouse-skip-word -1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1136 (point))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1137 (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1138 (goto-char end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1139 (mouse-skip-word 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1140 (point))))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1141 ((= mode 2)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1142 (list (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1143 (goto-char start)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1144 (beginning-of-line 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1145 (point))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1146 (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1147 (goto-char end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1148 (forward-line 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1149 (point))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1150
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1151 ;; Subroutine: set the mark where CLICK happened,
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1152 ;; but don't do anything else.
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1153 (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>
parents: 6231
diff changeset
1154 (mouse-minibuffer-check click)
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1155 (let ((posn (event-start click)))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1156 (select-window (posn-window posn))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1157 (if (numberp (posn-point posn))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1158 (push-mark (posn-point posn) t t))))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1159
15613
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1160 (defun mouse-undouble-last-event (events)
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1161 (let* ((index (1- (length events)))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1162 (last (nthcdr index events))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1163 (event (car last))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1164 (basic (event-basic-type event))
17983
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
1165 (old-modifiers (event-modifiers event))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
1166 (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>
parents: 15561
diff changeset
1167 (new
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1168 (if (consp event)
18503
828ca7cea30f (mouse-undouble-last-event): Use reverse, not nreverse.
Richard M. Stallman <rms@gnu.org>
parents: 18459
diff changeset
1169 ;; Use reverse, not nreverse, since event-modifiers
828ca7cea30f (mouse-undouble-last-event): Use reverse, not nreverse.
Richard M. Stallman <rms@gnu.org>
parents: 18459
diff changeset
1170 ;; does not copy the list it returns.
18689
d11c2164a6af (mouse-undouble-last-event): Fix gross bugs:
Richard M. Stallman <rms@gnu.org>
parents: 18675
diff changeset
1171 (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>
parents: 15561
diff changeset
1172 (cdr event))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1173 event)))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1174 (setcar last new)
17983
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
1175 (if (and (not (equal modifiers old-modifiers))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
1176 (key-binding (apply 'vector events)))
15613
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1177 t
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1178 (setcar last event)
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1179 nil)))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
1180
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1181 ;; Momentarily show where the mark is, if highlighting doesn't show it.
15941
f063cae001ee (mouse-region-delete-keys): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15880
diff changeset
1182
66669
550c8e306cb5 Fix special handling of DEL after dragging a region:
Richard M. Stallman <rms@gnu.org>
parents: 66322
diff changeset
1183 (defcustom mouse-region-delete-keys '([delete] [deletechar] [backspace])
550c8e306cb5 Fix special handling of DEL after dragging a region:
Richard M. Stallman <rms@gnu.org>
parents: 66322
diff changeset
1184 "List of keys that should cause the mouse region to be deleted."
550c8e306cb5 Fix special handling of DEL after dragging a region:
Richard M. Stallman <rms@gnu.org>
parents: 66322
diff changeset
1185 :group 'mouse
550c8e306cb5 Fix special handling of DEL after dragging a region:
Richard M. Stallman <rms@gnu.org>
parents: 66322
diff changeset
1186 :type '(repeat key-sequence))
15941
f063cae001ee (mouse-region-delete-keys): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15880
diff changeset
1187
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1188 (defun mouse-show-mark ()
57749
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1189 (let ((inhibit-quit t)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1190 (echo-keystrokes 0)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1191 event events key ignore
57780
8fe3a1b0606e (mouse-show-mark): Adjust to new name and don't assume
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57749
diff changeset
1192 (x-lost-selection-functions
57785
2a55e2b38c8d (mouse-show-mark): Replace the last occurrence of
Sam Steingold <sds@gnu.org>
parents: 57780
diff changeset
1193 (when (boundp 'x-lost-selection-functions)
2a55e2b38c8d (mouse-show-mark): Replace the last occurrence of
Sam Steingold <sds@gnu.org>
parents: 57780
diff changeset
1194 (copy-sequence x-lost-selection-functions))))
2a55e2b38c8d (mouse-show-mark): Replace the last occurrence of
Sam Steingold <sds@gnu.org>
parents: 57780
diff changeset
1195 (add-hook 'x-lost-selection-functions
57749
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1196 (lambda (seltype)
57785
2a55e2b38c8d (mouse-show-mark): Replace the last occurrence of
Sam Steingold <sds@gnu.org>
parents: 57780
diff changeset
1197 (when (eq seltype 'PRIMARY)
2a55e2b38c8d (mouse-show-mark): Replace the last occurrence of
Sam Steingold <sds@gnu.org>
parents: 57780
diff changeset
1198 (setq ignore t)
2a55e2b38c8d (mouse-show-mark): Replace the last occurrence of
Sam Steingold <sds@gnu.org>
parents: 57780
diff changeset
1199 (throw 'mouse-show-mark t))))
57749
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1200 (if transient-mark-mode
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1201 (delete-overlay mouse-drag-overlay)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1202 (move-overlay mouse-drag-overlay (point) (mark t)))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1203 (catch 'mouse-show-mark
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1204 ;; 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>
parents: 59128
diff changeset
1205 ;; Should we similarly handle `select-window' events? --Stef
57749
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1206 ;; Also ignore down-events that are undefined.
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1207 (while (progn (setq event (read-event))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1208 (setq events (append events (list event)))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1209 (setq key (apply 'vector events))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1210 (or (and (consp event)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1211 (eq (car event) 'switch-frame))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1212 (and (consp event)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1213 (eq (posn-point (event-end event))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1214 'vertical-scroll-bar))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1215 (and (memq 'down (event-modifiers event))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1216 (not (key-binding key))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1217 (not (mouse-undouble-last-event events))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1218 (not (member key mouse-region-delete-keys)))))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1219 (and (consp event)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1220 (or (eq (car event) 'switch-frame)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1221 (eq (posn-point (event-end event))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1222 'vertical-scroll-bar))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1223 (let ((keys (vector 'vertical-scroll-bar event)))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1224 (and (key-binding keys)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1225 (progn
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1226 (call-interactively (key-binding keys)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1227 nil keys)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1228 (setq events nil)))))))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1229 ;; If we lost the selection, just turn off the highlighting.
57785
2a55e2b38c8d (mouse-show-mark): Replace the last occurrence of
Sam Steingold <sds@gnu.org>
parents: 57780
diff changeset
1230 (unless ignore
57749
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1231 ;; For certain special keys, delete the region.
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1232 (if (member key mouse-region-delete-keys)
57927
ba164890f661 (mouse-show-mark): Get positions to delete from mark
Richard M. Stallman <rms@gnu.org>
parents: 57843
diff changeset
1233 (delete-region (mark t) (point))
57749
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1234 ;; Otherwise, unread the key so it gets executed normally.
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1235 (setq unread-command-events
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1236 (nconc events unread-command-events))))
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1237 (setq quit-flag nil)
08eb19d9ee4b (mouse-show-mark): Do most processing the same
Richard M. Stallman <rms@gnu.org>
parents: 57569
diff changeset
1238 (unless transient-mark-mode
43732
679c18d33c77 (mouse-show-mark): Remove the no-highlight alternative:
Eli Zaretskii <eliz@gnu.org>
parents: 43657
diff changeset
1239 (delete-overlay mouse-drag-overlay))))
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1240
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1241 (defun mouse-set-mark (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1242 "Set mark at the position clicked on with the mouse.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1243 Display cursor at that position for a second.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1244 This must be bound to a mouse click."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
1245 (interactive "e")
8534
a446d13c46ea (mouse-set-mark): Select the window before saving point.
Richard M. Stallman <rms@gnu.org>
parents: 8519
diff changeset
1246 (mouse-minibuffer-check click)
a446d13c46ea (mouse-set-mark): Select the window before saving point.
Richard M. Stallman <rms@gnu.org>
parents: 8519
diff changeset
1247 (select-window (posn-window (event-start click)))
a446d13c46ea (mouse-set-mark): Select the window before saving point.
Richard M. Stallman <rms@gnu.org>
parents: 8519
diff changeset
1248 ;; We don't use save-excursion because that preserves the mark too.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1249 (let ((point-save (point)))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1250 (unwind-protect
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1251 (progn (mouse-set-point click)
3119
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
1252 (push-mark nil t t)
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
1253 (or transient-mark-mode
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
1254 (sit-for 1)))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1255 (goto-char point-save))))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1256
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1257 (defun mouse-kill (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1258 "Kill the region between point and the mouse click.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1259 The text is saved in the kill ring, as with \\[kill-region]."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
1260 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
1261 (mouse-minibuffer-check click)
6301
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
1262 (let* ((posn (event-start click))
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
1263 (click-posn (posn-point posn)))
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
1264 (select-window (posn-window posn))
1039
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
1265 (if (numberp click-posn)
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
1266 (kill-region (min (point) click-posn)
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
1267 (max (point) click-posn)))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1268
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
1269 (defun mouse-yank-at-click (click arg)
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
1270 "Insert the last stretch of killed text at the position clicked on.
28922
c0732e5c1f58 (mouse-yank-at-click): Doc fix.
Gerd Moellmann <gerd@gnu.org>
parents: 28075
diff changeset
1271 Also move point to one end of the text thus inserted (normally the end),
42149
111acebcb4e0 Fix typo.
Pavel Janík <Pavel@Janik.cz>
parents: 42004
diff changeset
1272 and set mark at the beginning.
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1273 Prefix arguments are interpreted as with \\[yank].
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1274 If `mouse-yank-at-point' is non-nil, insert at point
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1275 regardless of where you click."
57843
e91b3798021f (mouse-yank-at-click, mouse-yank-secondary): Revert
Jan Djärv <jan.h.d@swipnet.se>
parents: 57785
diff changeset
1276 (interactive "e\nP")
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
1277 ;; Give temporary modes such as isearch a chance to turn off.
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
1278 (run-hooks 'mouse-leave-buffer-hook)
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1279 (or mouse-yank-at-point (mouse-set-point click))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1280 (setq this-command 'yank)
12357
8d2679d3f095 (mouse-yank-at-click): Clear mouse-selection-click-count.
Richard M. Stallman <rms@gnu.org>
parents: 12257
diff changeset
1281 (setq mouse-selection-click-count 0)
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
1282 (yank arg))
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
1283
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
1284 (defun mouse-kill-ring-save (click)
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1285 "Copy the region between point and the mouse click in the kill ring.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1286 This does not delete the region; it acts like \\[kill-ring-save]."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
1287 (interactive "e")
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1288 (mouse-set-mark-fast click)
8135
1f57b34ade27 (mouse-drag-region): Bind this-command like last-command.
Richard M. Stallman <rms@gnu.org>
parents: 8117
diff changeset
1289 (let (this-command last-command)
1f57b34ade27 (mouse-drag-region): Bind this-command like last-command.
Richard M. Stallman <rms@gnu.org>
parents: 8117
diff changeset
1290 (kill-ring-save (point) (mark t)))
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
1291 (mouse-show-mark))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1292
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1293 ;;; This function used to delete the text between point and the mouse
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1294 ;;; whenever it was equal to the front of the kill ring, but some
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1295 ;;; people found that confusing.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1296
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1297 ;;; A list (TEXT START END), describing the text and position of the last
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1298 ;;; invocation of mouse-save-then-kill.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1299 (defvar mouse-save-then-kill-posn nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1300
5007
8ed435ca9650 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 4906
diff changeset
1301 (defun mouse-save-then-kill-delete-region (beg end)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1302 ;; We must make our own undo boundaries
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1303 ;; because they happen automatically only for the current buffer.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1304 (undo-boundary)
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1305 (if (or (= beg end) (eq buffer-undo-list t))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1306 ;; If we have no undo list in this buffer,
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1307 ;; just delete.
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1308 (delete-region beg end)
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1309 ;; Delete, but make the undo-list entry share with the kill ring.
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1310 ;; First, delete just one char, so in case buffer is being modified
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1311 ;; for the first time, the undo list records that fact.
29344
2f44841e5506 (mouse-save-then-kill-delete-region): Don't bind
Dave Love <fx@gnu.org>
parents: 28922
diff changeset
1312 (let (before-change-functions after-change-functions)
7866
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
1313 (delete-region beg
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
1314 (+ beg (if (> end beg) 1 -1))))
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1315 (let ((buffer-undo-list buffer-undo-list))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1316 ;; Undo that deletion--but don't change the undo list!
29344
2f44841e5506 (mouse-save-then-kill-delete-region): Don't bind
Dave Love <fx@gnu.org>
parents: 28922
diff changeset
1317 (let (before-change-functions after-change-functions)
7866
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
1318 (primitive-undo 1 buffer-undo-list))
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1319 ;; Now delete the rest of the specified region,
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1320 ;; but don't record it.
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1321 (setq buffer-undo-list t)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1322 (if (/= (length (car kill-ring)) (- (max end beg) (min end beg)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1323 (error "Lossage in mouse-save-then-kill-delete-region"))
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1324 (delete-region beg end))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1325 (let ((tail buffer-undo-list))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1326 ;; Search back in buffer-undo-list for the string
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1327 ;; that came from deleting one character.
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1328 (while (and tail (not (stringp (car (car tail)))))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1329 (setq tail (cdr tail)))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1330 ;; Replace it with an entry for the entire deleted text.
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1331 (and tail
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1332 (setcar tail (cons (car kill-ring) (min beg end))))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1333 (undo-boundary))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
1334
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
1335 (defun mouse-save-then-kill (click)
1765
1cc3ee5afc82 (mouse-save-then-kill): When deleting, avoid delay
Richard M. Stallman <rms@gnu.org>
parents: 1728
diff changeset
1336 "Save text to point in kill ring; the second time, kill the text.
1cc3ee5afc82 (mouse-save-then-kill): When deleting, avoid delay
Richard M. Stallman <rms@gnu.org>
parents: 1728
diff changeset
1337 If the text between point and the mouse is the same as what's
1cc3ee5afc82 (mouse-save-then-kill): When deleting, avoid delay
Richard M. Stallman <rms@gnu.org>
parents: 1728
diff changeset
1338 at the front of the kill ring, this deletes the text.
1cc3ee5afc82 (mouse-save-then-kill): When deleting, avoid delay
Richard M. Stallman <rms@gnu.org>
parents: 1728
diff changeset
1339 Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
1340 which prepares for a second click to delete the text.
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
1341
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
1342 If you have selected words or lines, this command extends the
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
1343 selection through the word or line clicked on. If you do this
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
1344 again in a different position, it extends the selection again.
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1345 If you do this twice in the same position, the selection is killed."
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
1346 (interactive "e")
21426
4b4a4e32ffef (mouse-save-then-kill): Get point-before-scroll
Richard M. Stallman <rms@gnu.org>
parents: 21194
diff changeset
1347 (let ((before-scroll
4b4a4e32ffef (mouse-save-then-kill): Get point-before-scroll
Richard M. Stallman <rms@gnu.org>
parents: 21194
diff changeset
1348 (with-current-buffer (window-buffer (posn-window (event-start click)))
4b4a4e32ffef (mouse-save-then-kill): Get point-before-scroll
Richard M. Stallman <rms@gnu.org>
parents: 21194
diff changeset
1349 point-before-scroll)))
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1350 (mouse-minibuffer-check click)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1351 (let ((click-posn (posn-point (event-start click)))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1352 ;; Don't let a subsequent kill command append to this one:
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1353 ;; prevent setting this-command to kill-region.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1354 (this-command this-command))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1355 (if (and (with-current-buffer
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1356 (window-buffer (posn-window (event-start click)))
12436
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
1357 (and (mark t) (> (mod mouse-selection-click-count 3) 0)
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
1358 ;; Don't be fooled by a recent click in some other buffer.
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1359 (eq mouse-selection-click-count-buffer
12436
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
1360 (current-buffer)))))
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1361 (if (not (and (eq last-command 'mouse-save-then-kill)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1362 (equal click-posn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1363 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1364 ;; Find both ends of the object selected by this click.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1365 (let* ((range
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1366 (mouse-start-end click-posn click-posn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1367 mouse-selection-click-count)))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1368 ;; Move whichever end is closer to the click.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1369 ;; That's what xterm does, and it seems reasonable.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1370 (if (< (abs (- click-posn (mark t)))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1371 (abs (- click-posn (point))))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1372 (set-mark (car range))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1373 (goto-char (nth 1 range)))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1374 ;; We have already put the old region in the kill ring.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1375 ;; Replace it with the extended region.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1376 ;; (It would be annoying to make a separate entry.)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1377 (kill-new (buffer-substring (point) (mark t)) t)
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
1378 (mouse-set-region-1)
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1379 ;; Arrange for a repeated mouse-3 to kill this region.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1380 (setq mouse-save-then-kill-posn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1381 (list (car kill-ring) (point) click-posn))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1382 (mouse-show-mark))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1383 ;; If we click this button again without moving it,
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1384 ;; that time kill.
11818
f470809e6a60 (mouse-save-then-kill): When making a new region
Richard M. Stallman <rms@gnu.org>
parents: 11453
diff changeset
1385 (mouse-save-then-kill-delete-region (mark) (point))
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1386 (setq mouse-selection-click-count 0)
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
1387 (setq mouse-save-then-kill-posn nil))
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1388 (if (and (eq last-command 'mouse-save-then-kill)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1389 mouse-save-then-kill-posn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1390 (eq (car mouse-save-then-kill-posn) (car kill-ring))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1391 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1392 ;; If this is the second time we've called
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1393 ;; mouse-save-then-kill, delete the text from the buffer.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1394 (progn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1395 (mouse-save-then-kill-delete-region (point) (mark))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1396 ;; After we kill, another click counts as "the first time".
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1397 (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>
parents: 15169
diff changeset
1398 ;; This is not a repetition.
1aeaf1224f0b (mouse-show-mark): Use temporary highlighting if possible instead of a pause.
Richard M. Stallman <rms@gnu.org>
parents: 15169
diff changeset
1399 ;; We are adjusting an old selection or creating a new one.
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1400 (if (or (and (eq last-command 'mouse-save-then-kill)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1401 mouse-save-then-kill-posn)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1402 (and mark-active transient-mark-mode)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1403 (and (memq last-command
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1404 '(mouse-drag-region mouse-set-region))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1405 (or mark-even-if-inactive
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1406 (not transient-mark-mode))))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1407 ;; We have a selection or suitable region, so adjust it.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1408 (let* ((posn (event-start click))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1409 (new (posn-point posn)))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1410 (select-window (posn-window posn))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1411 (if (numberp new)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1412 (progn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1413 ;; Move whichever end of the region is closer to the click.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1414 ;; That is what xterm does, and it seems reasonable.
36134
0d7ea691acc4 (mouse-save-then-kill): If the distance from the new
Gerd Moellmann <gerd@gnu.org>
parents: 33769
diff changeset
1415 (if (<= (abs (- new (point))) (abs (- new (mark t))))
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1416 (goto-char new)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1417 (set-mark new))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1418 (setq deactivate-mark nil)))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1419 (kill-new (buffer-substring (point) (mark t)) t))
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1420 ;; Set the mark where point is, then move where clicked.
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1421 (mouse-set-mark-fast click)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1422 (if before-scroll
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1423 (goto-char before-scroll))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1424 (exchange-point-and-mark) ;Why??? --Stef
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1425 (kill-new (buffer-substring (point) (mark t))))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1426 (mouse-show-mark)
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
1427 (mouse-set-region-1)
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1428 (setq mouse-save-then-kill-posn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1429 (list (car kill-ring) (point) click-posn)))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1430
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1431 (global-set-key [M-mouse-1] 'mouse-start-secondary)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1432 (global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1433 (global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1434 (global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1435 (global-set-key [M-mouse-2] 'mouse-yank-secondary)
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
1436
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1437 (defconst mouse-secondary-overlay
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1438 (let ((ol (make-overlay (point-min) (point-min))))
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1439 (delete-overlay ol)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1440 (overlay-put ol 'face 'secondary-selection)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1441 ol)
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1442 "An overlay which records the current secondary selection.
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1443 It is deleted when there is no secondary selection.")
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1444
9206
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1445 (defvar mouse-secondary-click-count 0)
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1446
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1447 ;; A marker which records the specified first end for a secondary selection.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1448 ;; May be nil.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1449 (defvar mouse-secondary-start nil)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1450
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1451 (defun mouse-start-secondary (click)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1452 "Set one end of the secondary selection to the position clicked on.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1453 Use \\[mouse-secondary-save-then-kill] to set the other end
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1454 and complete the secondary selection."
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1455 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
1456 (mouse-minibuffer-check click)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1457 (let ((posn (event-start click)))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1458 (with-current-buffer (window-buffer (posn-window posn))
3823
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1459 ;; Cancel any preexisting secondary selection.
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1460 (delete-overlay mouse-secondary-overlay)
3823
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1461 (if (numberp (posn-point posn))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1462 (progn
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1463 (or mouse-secondary-start
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1464 (setq mouse-secondary-start (make-marker)))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1465 (move-marker mouse-secondary-start (posn-point posn)))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1466
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1467 (defun mouse-set-secondary (click)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1468 "Set the secondary selection to the text that the mouse is dragged over.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1469 This must be bound to a mouse drag event."
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1470 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
1471 (mouse-minibuffer-check click)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1472 (let ((posn (event-start click))
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1473 beg
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1474 (end (event-end click)))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1475 (with-current-buffer (window-buffer (posn-window posn))
3823
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1476 (if (numberp (posn-point posn))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1477 (setq beg (posn-point posn)))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1478 (move-overlay mouse-secondary-overlay beg (posn-point end)))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1479
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1480 (defun mouse-drag-secondary (start-event)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1481 "Set the secondary selection to the text that the mouse is dragged over.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1482 Highlight the drag area as you move the mouse.
16318
86f1da650461 (mouse-drag-secondary): Make sure to return nil
Richard M. Stallman <rms@gnu.org>
parents: 16304
diff changeset
1483 This must be bound to a button-down mouse event.
86f1da650461 (mouse-drag-secondary): Make sure to return nil
Richard M. Stallman <rms@gnu.org>
parents: 16304
diff changeset
1484 The function returns a non-nil value if it creates a secondary selection."
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1485 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
1486 (mouse-minibuffer-check start-event)
14179
7db5b89b78b6 (mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
parents: 13872
diff changeset
1487 (let* ((echo-keystrokes 0)
7db5b89b78b6 (mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
parents: 13872
diff changeset
1488 (start-posn (event-start start-event))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1489 (start-point (posn-point start-posn))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1490 (start-window (posn-window start-posn))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1491 (bounds (window-edges start-window))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1492 (top (nth 1 bounds))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1493 (bottom (if (window-minibuffer-p start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1494 (nth 3 bounds)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1495 ;; Don't count the mode line.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1496 (1- (nth 3 bounds))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1497 (click-count (1- (event-click-count start-event))))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1498 (with-current-buffer (window-buffer start-window)
9206
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1499 (setq mouse-secondary-click-count click-count)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1500 (if (> (mod click-count 3) 0)
5007
8ed435ca9650 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 4906
diff changeset
1501 ;; Double or triple press: make an initial selection
8ed435ca9650 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 4906
diff changeset
1502 ;; of one word or line.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1503 (let ((range (mouse-start-end start-point start-point click-count)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1504 (set-marker mouse-secondary-start nil)
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1505 ;; Why the double move? --Stef
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1506 ;; (move-overlay mouse-secondary-overlay 1 1
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1507 ;; (window-buffer start-window))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1508 (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1509 (window-buffer start-window)))
5007
8ed435ca9650 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 4906
diff changeset
1510 ;; Single-press: cancel any preexisting secondary selection.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1511 (or mouse-secondary-start
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1512 (setq mouse-secondary-start (make-marker)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1513 (set-marker mouse-secondary-start start-point)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1514 (delete-overlay mouse-secondary-overlay))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1515 (let (event end end-point)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1516 (track-mouse
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1517 (while (progn
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1518 (setq event (read-event))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1519 (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>
parents: 59128
diff changeset
1520 (memq (car-safe event) '(switch-frame select-window))))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1521
59470
f009f3970cd9 (mouse-drag-mode-line-1, mouse-drag-vertical-line, mouse-drag-region)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59128
diff changeset
1522 (if (memq (car-safe event) '(switch-frame select-window))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1523 nil
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1524 (setq end (event-end event)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1525 end-point (posn-point end))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1526 (cond
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1527 ;; Are we moving within the original window?
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1528 ((and (eq (posn-window end) start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1529 (integer-or-marker-p end-point))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1530 (let ((range (mouse-start-end start-point end-point
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1531 click-count)))
8224
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1532 (if (or (/= start-point end-point)
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1533 (null (marker-position mouse-secondary-start)))
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1534 (progn
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1535 (set-marker mouse-secondary-start nil)
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1536 (move-overlay mouse-secondary-overlay
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1537 (car range) (nth 1 range))))))
7588
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1538 (t
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1539 (let ((mouse-row (cdr (cdr (mouse-position)))))
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1540 (cond
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1541 ((null mouse-row))
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1542 ((< mouse-row top)
7932
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
1543 (mouse-scroll-subr start-window (- mouse-row top)
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
1544 mouse-secondary-overlay start-point))
8064
d04a39ce4f1d (mouse-scroll-subr): Don't do anything special at eob.
Richard M. Stallman <rms@gnu.org>
parents: 7966
diff changeset
1545 ((>= mouse-row bottom)
7932
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
1546 (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
7588
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1547 mouse-secondary-overlay start-point)))))))))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1548
7966
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
1549 (if (consp event)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1550 (if (marker-position mouse-secondary-start)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1551 (save-window-excursion
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1552 (delete-overlay mouse-secondary-overlay)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1553 (x-set-selection 'SECONDARY nil)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1554 (select-window start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1555 (save-excursion
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1556 (goto-char mouse-secondary-start)
16318
86f1da650461 (mouse-drag-secondary): Make sure to return nil
Richard M. Stallman <rms@gnu.org>
parents: 16304
diff changeset
1557 (sit-for 1)
86f1da650461 (mouse-drag-secondary): Make sure to return nil
Richard M. Stallman <rms@gnu.org>
parents: 16304
diff changeset
1558 nil))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1559 (x-set-selection
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1560 'SECONDARY
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1561 (buffer-substring (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1562 (overlay-end mouse-secondary-overlay)))))))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1563
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1564 (defun mouse-yank-secondary (click)
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1565 "Insert the secondary selection at the position clicked on.
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1566 Move point to the end of the inserted text.
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1567 If `mouse-yank-at-point' is non-nil, insert at point
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1568 regardless of where you click."
57843
e91b3798021f (mouse-yank-at-click, mouse-yank-secondary): Revert
Jan Djärv <jan.h.d@swipnet.se>
parents: 57785
diff changeset
1569 (interactive "e")
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
1570 ;; Give temporary modes such as isearch a chance to turn off.
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
1571 (run-hooks 'mouse-leave-buffer-hook)
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1572 (or mouse-yank-at-point (mouse-set-point click))
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1573 (insert (x-get-selection 'SECONDARY)))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1574
5280
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1575 (defun mouse-kill-secondary ()
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1576 "Kill the text in the secondary selection.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1577 This is intended more as a keyboard command than as a mouse command
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1578 but it can work as either one.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1579
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1580 The current buffer (in case of keyboard use), or the buffer clicked on,
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1581 must be the one that the secondary selection is in. This requirement
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1582 is to prevent accidents."
5280
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1583 (interactive)
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1584 (let* ((keys (this-command-keys))
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1585 (click (elt keys (1- (length keys)))))
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1586 (or (eq (overlay-buffer mouse-secondary-overlay)
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1587 (if (listp click)
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1588 (window-buffer (posn-window (event-start click)))
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1589 (current-buffer)))
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1590 (error "Select or click on the buffer where the secondary selection is")))
10838
6c0dc7a8a07a (mouse-kill-secondary): Avoid changing this-command.
Richard M. Stallman <rms@gnu.org>
parents: 10790
diff changeset
1591 (let (this-command)
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1592 (with-current-buffer (overlay-buffer mouse-secondary-overlay)
10838
6c0dc7a8a07a (mouse-kill-secondary): Avoid changing this-command.
Richard M. Stallman <rms@gnu.org>
parents: 10790
diff changeset
1593 (kill-region (overlay-start mouse-secondary-overlay)
6c0dc7a8a07a (mouse-kill-secondary): Avoid changing this-command.
Richard M. Stallman <rms@gnu.org>
parents: 10790
diff changeset
1594 (overlay-end mouse-secondary-overlay))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1595 (delete-overlay mouse-secondary-overlay)
10838
6c0dc7a8a07a (mouse-kill-secondary): Avoid changing this-command.
Richard M. Stallman <rms@gnu.org>
parents: 10790
diff changeset
1596 ;;; (x-set-selection 'SECONDARY nil)
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1597 )
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1598
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1599 (defun mouse-secondary-save-then-kill (click)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1600 "Save text to point in kill ring; the second time, kill the text.
7302
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1601 You must use this in a buffer where you have recently done \\[mouse-start-secondary].
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1602 If the text between where you did \\[mouse-start-secondary] and where
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1603 you use this command matches the text at the front of the kill ring,
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1604 this command deletes the text.
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1605 Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
7302
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1606 which prepares for a second click with this command to delete the text.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1607
7302
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1608 If you have already made a secondary selection in that buffer,
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1609 this command extends or retracts the selection to where you click.
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1610 If you do this again in a different position, it extends or retracts
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1611 again. If you do this twice in the same position, it kills the selection."
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1612 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
1613 (mouse-minibuffer-check click)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1614 (let ((posn (event-start click))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1615 (click-posn (posn-point (event-start click)))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1616 ;; Don't let a subsequent kill command append to this one:
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1617 ;; prevent setting this-command to kill-region.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1618 (this-command this-command))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1619 (or (eq (window-buffer (posn-window posn))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1620 (or (overlay-buffer mouse-secondary-overlay)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1621 (if mouse-secondary-start
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1622 (marker-buffer mouse-secondary-start))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1623 (error "Wrong buffer"))
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1624 (with-current-buffer (window-buffer (posn-window posn))
9206
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1625 (if (> (mod mouse-secondary-click-count 3) 0)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1626 (if (not (and (eq last-command 'mouse-secondary-save-then-kill)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1627 (equal click-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1628 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1629 ;; Find both ends of the object selected by this click.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1630 (let* ((range
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1631 (mouse-start-end click-posn click-posn
9206
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1632 mouse-secondary-click-count)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1633 ;; Move whichever end is closer to the click.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1634 ;; That's what xterm does, and it seems reasonable.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1635 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1636 (abs (- click-posn (overlay-end mouse-secondary-overlay))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1637 (move-overlay mouse-secondary-overlay (car range)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1638 (overlay-end mouse-secondary-overlay))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1639 (move-overlay mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1640 (overlay-start mouse-secondary-overlay)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1641 (nth 1 range)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1642 ;; We have already put the old region in the kill ring.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1643 ;; Replace it with the extended region.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1644 ;; (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>
parents: 8534
diff changeset
1645 (kill-new (buffer-substring
77933f36ddc2 (mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
parents: 8534
diff changeset
1646 (overlay-start mouse-secondary-overlay)
77933f36ddc2 (mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
parents: 8534
diff changeset
1647 (overlay-end mouse-secondary-overlay)) t)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1648 ;; Arrange for a repeated mouse-3 to kill this region.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1649 (setq mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1650 (list (car kill-ring) (point) click-posn)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1651 ;; If we click this button again without moving it,
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1652 ;; that time kill.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1653 (progn
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1654 (mouse-save-then-kill-delete-region
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1655 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1656 (overlay-end mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1657 (setq mouse-save-then-kill-posn nil)
9206
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1658 (setq mouse-secondary-click-count 0)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1659 (delete-overlay mouse-secondary-overlay)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1660 (if (and (eq last-command 'mouse-secondary-save-then-kill)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1661 mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1662 (eq (car mouse-save-then-kill-posn) (car kill-ring))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1663 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1664 ;; If this is the second time we've called
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1665 ;; mouse-secondary-save-then-kill, delete the text from the buffer.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1666 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1667 (mouse-save-then-kill-delete-region
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1668 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1669 (overlay-end mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1670 (setq mouse-save-then-kill-posn nil)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1671 (delete-overlay mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1672 (if (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1673 ;; We have a selection, so adjust it.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1674 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1675 (if (numberp click-posn)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1676 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1677 ;; Move whichever end of the region is closer to the click.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1678 ;; That is what xterm does, and it seems reasonable.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1679 (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1680 (abs (- click-posn (overlay-end mouse-secondary-overlay))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1681 (move-overlay mouse-secondary-overlay click-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1682 (overlay-end mouse-secondary-overlay))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1683 (move-overlay mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1684 (overlay-start mouse-secondary-overlay)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1685 click-posn))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1686 (setq deactivate-mark nil)))
8224
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1687 (if (eq last-command 'mouse-secondary-save-then-kill)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1688 ;; 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>
parents: 8534
diff changeset
1689 ;; 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>
parents: 8534
diff changeset
1690 ;; 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>
parents: 8534
diff changeset
1691 ;; (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>
parents: 8534
diff changeset
1692 (kill-new (buffer-substring
8224
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1693 (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>
parents: 8534
diff changeset
1694 (overlay-end mouse-secondary-overlay)) t)
21194
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
1695 (let (deactivate-mark)
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
1696 (copy-region-as-kill (overlay-start mouse-secondary-overlay)
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
1697 (overlay-end mouse-secondary-overlay)))))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1698 (if mouse-secondary-start
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1699 ;; All we have is one end of a selection,
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1700 ;; so put the other end here.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1701 (let ((start (+ 0 mouse-secondary-start)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1702 (kill-ring-save start click-posn)
65640
906677409870 (mouse-move-drag-overlay): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65623
diff changeset
1703 (move-overlay mouse-secondary-overlay start click-posn))))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1704 (setq mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1705 (list (car kill-ring) (point) click-posn))))
10782
806b3e3fd93c (mouse-buffer-menu): Don't clear selection when we kill it.
Richard M. Stallman <rms@gnu.org>
parents: 10720
diff changeset
1706 (if (overlay-buffer mouse-secondary-overlay)
806b3e3fd93c (mouse-buffer-menu): Don't clear selection when we kill it.
Richard M. Stallman <rms@gnu.org>
parents: 10720
diff changeset
1707 (x-set-selection 'SECONDARY
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1708 (buffer-substring
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1709 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1710 (overlay-end mouse-secondary-overlay)))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1711
21148
bbbd345f54de (mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
parents: 20686
diff changeset
1712 (defcustom mouse-buffer-menu-maxlen 20
13872
e79f2b570509 (mouse-menu-buffer-maxlen): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13870
diff changeset
1713 "*Number of buffers in one pane (submenu) of the buffer menu.
e79f2b570509 (mouse-menu-buffer-maxlen): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13870
diff changeset
1714 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>
parents: 20686
diff changeset
1715 `mouse-buffer-menu-maxlen' and make a pane (or submenu) for each one."
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
1716 :type 'integer
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
1717 :group 'mouse)
13872
e79f2b570509 (mouse-menu-buffer-maxlen): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13870
diff changeset
1718
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1719 (defcustom mouse-buffer-menu-mode-mult 4
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1720 "*Group the buffers by the major mode groups on \\[mouse-buffer-menu]?
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1721 This number which determines (in a hairy way) whether \\[mouse-buffer-menu]
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1722 will split the buffer menu by the major modes (see
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1723 `mouse-buffer-menu-mode-groups') or just by menu length.
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1724 Set to 1 (or even 0!) if you want to group by major mode always, and to
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1725 a large number if you prefer a mixed multitude. The default is 4."
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1726 :type 'integer
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1727 :group 'mouse
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1728 :version "20.3")
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1729
16989
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1730 (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>
parents: 16746
diff changeset
1731 '(("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>
parents: 16746
diff changeset
1732 ("\\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>
parents: 16746
diff changeset
1733 . "Mail/News")
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1734 ("\\<C\\>" . "C")
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1735 ("ObjC" . "C")
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1736 ("Text" . "Text")
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1737 ("Outline" . "Text")
40379
00827567d7bd (mouse-buffer-menu-mode-groups): added SGML group
Sam Steingold <sds@gnu.org>
parents: 40268
diff changeset
1738 ("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML")
00827567d7bd (mouse-buffer-menu-mode-groups): added SGML group
Sam Steingold <sds@gnu.org>
parents: 40268
diff changeset
1739 ("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>
parents: 16746
diff changeset
1740 ("Lisp" . "Lisp"))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1741 "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>
parents: 16746
diff changeset
1742 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>
parents: 16746
diff changeset
1743 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>
parents: 16746
diff changeset
1744
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
1745 (defun mouse-buffer-menu (event)
1728
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
1746 "Pop up a menu of buffers for selection with the mouse.
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
1747 This switches buffers in the window that you clicked on,
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
1748 and selects that window."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
1749 (interactive "e")
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
1750 (mouse-minibuffer-check event)
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1751 (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>
parents: 16746
diff changeset
1752 ;; 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>
parents: 16746
diff changeset
1753 (let ((tail buffers))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1754 (while tail
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1755 ;; 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>
parents: 16746
diff changeset
1756 ;; 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>
parents: 16746
diff changeset
1757 (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>
parents: 16746
diff changeset
1758 (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>
parents: 16746
diff changeset
1759 (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>
parents: 16746
diff changeset
1760 (while tail
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1761 (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>
parents: 16746
diff changeset
1762 (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>
parents: 16746
diff changeset
1763 (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>
parents: 16746
diff changeset
1764 (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>
parents: 16746
diff changeset
1765 (if (null elt)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1766 (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>
parents: 16746
diff changeset
1767 (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>
parents: 16746
diff changeset
1768 adjusted-major-mode
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1769 mode-name))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1770 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>
parents: 16746
diff changeset
1771 (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>
parents: 16746
diff changeset
1772 (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>
parents: 16746
diff changeset
1773 (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>
parents: 16746
diff changeset
1774 ;; 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>
parents: 16746
diff changeset
1775 (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>
parents: 16746
diff changeset
1776 (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>
parents: 16746
diff changeset
1777 (while tail
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1778 (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>
parents: 16746
diff changeset
1779 (+ sum-of-squares
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1780 (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>
parents: 16746
diff changeset
1781 (setq tail (cdr tail))))
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1782 (if (< (* sum-of-squares mouse-buffer-menu-mode-mult)
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1783 (* (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>
parents: 16746
diff changeset
1784 ;; 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>
parents: 16746
diff changeset
1785 (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>
parents: 16746
diff changeset
1786 ;; 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>
parents: 16746
diff changeset
1787 (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>
parents: 16746
diff changeset
1788 (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>
parents: 16746
diff changeset
1789 (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>
parents: 16746
diff changeset
1790 (> (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>
parents: 16746
diff changeset
1791 ;; 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>
parents: 16746
diff changeset
1792 ;; 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>
parents: 16746
diff changeset
1793 ;; 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>
parents: 16746
diff changeset
1794 (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>
parents: 16746
diff changeset
1795 (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>
parents: 16746
diff changeset
1796 (> (* buffers-left 10) (length buffers))))
38982
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1797 (let ((this-mode-list (mouse-buffer-menu-alist
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1798 (cdr (cdr (car split-by-major-mode))))))
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1799 (and this-mode-list
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1800 (setq subdivided-menus
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1801 (cons (cons
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1802 (nth 1 (car split-by-major-mode))
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1803 this-mode-list)
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1804 subdivided-menus))))
16989
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1805 (setq buffers-left
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1806 (- 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>
parents: 16746
diff changeset
1807 (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>
parents: 16746
diff changeset
1808 ;; 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>
parents: 16746
diff changeset
1809 ;; 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>
parents: 16746
diff changeset
1810 (if split-by-major-mode
38982
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1811 (let ((others-list
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1812 (mouse-buffer-menu-alist
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1813 ;; we don't need split-by-major-mode any more,
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1814 ;; so we can ditch it with nconc.
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1815 (apply 'nconc (mapcar 'cddr split-by-major-mode)))))
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1816 (and others-list
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1817 (setq subdivided-menus
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1818 (cons (cons "Others" others-list)
f12d1ec614e9 (mouse-buffer-menu): If the buffer menu is split by
Eli Zaretskii <eliz@gnu.org>
parents: 38763
diff changeset
1819 subdivided-menus)))))
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1820 (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>
parents: 16746
diff changeset
1821 (progn
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1822 (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>
parents: 16746
diff changeset
1823 (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>
parents: 16746
diff changeset
1824 (mouse-buffer-menu-split "Select Buffer" alist)))))
1728
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
1825 (let ((buf (x-popup-menu event menu))
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
1826 (window (posn-window (event-start event))))
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1827 (when buf
41033
0701d564260d (mouse-show-mark): Either move point to the mark
Richard M. Stallman <rms@gnu.org>
parents: 40648
diff changeset
1828 (select-window
0701d564260d (mouse-show-mark): Either move point to the mark
Richard M. Stallman <rms@gnu.org>
parents: 40648
diff changeset
1829 (if (framep window) (frame-selected-window window)
0701d564260d (mouse-show-mark): Either move point to the mark
Richard M. Stallman <rms@gnu.org>
parents: 40648
diff changeset
1830 window))
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1831 (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>
parents: 16746
diff changeset
1832
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1833 (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>
parents: 16746
diff changeset
1834 (let (tail
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1835 (maxlen 0)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1836 head)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1837 (setq buffers
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1838 (sort buffers
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1839 (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>
parents: 16746
diff changeset
1840 (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>
parents: 16746
diff changeset
1841 (setq tail buffers)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1842 (while tail
63849
91ca3ff1b216 (mouse-buffer-menu-alist): Change space constants followed by a sexp to "?\s ".
Juanma Barranquero <lekktu@gmail.com>
parents: 63256
diff changeset
1843 (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>
parents: 16746
diff changeset
1844 (setq maxlen
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1845 (max maxlen
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1846 (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>
parents: 16746
diff changeset
1847 (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>
parents: 16746
diff changeset
1848 (setq tail buffers)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1849 (while tail
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1850 (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>
parents: 16746
diff changeset
1851 (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>
parents: 16746
diff changeset
1852 (setq head
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1853 (cons
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
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>
parents: 16746
diff changeset
1855 (format
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1856 (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>
parents: 16746
diff changeset
1857 (buffer-name elt)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1858 (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>
parents: 16746
diff changeset
1859 (save-excursion
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1860 (set-buffer elt)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1861 (if buffer-read-only "%" " "))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1862 (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>
parents: 16746
diff changeset
1863 (save-excursion
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1864 (set-buffer elt)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1865 (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>
parents: 16746
diff changeset
1866 (expand-file-name
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1867 list-buffers-directory)))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1868 ""))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1869 elt)
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1870 head))))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1871 (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>
parents: 16746
diff changeset
1872 ;; 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>
parents: 16746
diff changeset
1873 (nreverse head)))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1874
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1875 (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>
parents: 16746
diff changeset
1876 ;; 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>
parents: 16746
diff changeset
1877 ;; 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>
parents: 20686
diff changeset
1878 (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>
parents: 16746
diff changeset
1879 (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>
parents: 16746
diff changeset
1880 (i 1))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1881 (while alist
21148
bbbd345f54de (mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
parents: 20686
diff changeset
1882 ;; 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>
parents: 16746
diff changeset
1883 ;; 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>
parents: 20686
diff changeset
1884 (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>
parents: 16746
diff changeset
1885 (if next
21148
bbbd345f54de (mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
parents: 20686
diff changeset
1886 (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>
parents: 16746
diff changeset
1887 nil))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1888 (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>
parents: 16746
diff changeset
1889 sublists))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1890 (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>
parents: 16746
diff changeset
1891 (setq alist next))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1892 (nreverse sublists))
4e31b0ff76a9 (mouse-buffer-menu): Group buffers by major modes if that seems to be useful.
Richard M. Stallman <rms@gnu.org>
parents: 16746
diff changeset
1893 ;; 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>
parents: 16746
diff changeset
1894 (list (cons title alist))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1895
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1896 ;;; These need to be rewritten for the new scroll bar implementation.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1897
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1898 ;;;!! ;; Commands for the scroll bar.
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1899 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1900 ;;;!! (defun mouse-scroll-down (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1901 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1902 ;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1903 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1904 ;;;!! (defun mouse-scroll-up (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1905 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1906 ;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1907 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1908 ;;;!! (defun mouse-scroll-down-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1909 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1910 ;;;!! (scroll-down nil))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1911 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1912 ;;;!! (defun mouse-scroll-up-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1913 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1914 ;;;!! (scroll-up nil))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1915 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1916 ;;;!! (defun mouse-scroll-move-cursor (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1917 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1918 ;;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1919 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1920 ;;;!! (defun mouse-scroll-absolute (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1921 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1922 ;;;!! (let* ((pos (car event))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1923 ;;;!! (position (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1924 ;;;!! (length (car (cdr pos))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1925 ;;;!! (if (<= length 0) (setq length 1))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1926 ;;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1927 ;;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1928 ;;;!! position)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1929 ;;;!! length)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1930 ;;;!! scale-factor)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1931 ;;;!! (goto-char newpos)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1932 ;;;!! (recenter '(4)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1933 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1934 ;;;!! (defun mouse-scroll-left (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1935 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1936 ;;;!! (scroll-left (1+ (car (mouse-coords click)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1937 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1938 ;;;!! (defun mouse-scroll-right (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1939 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1940 ;;;!! (scroll-right (1+ (car (mouse-coords click)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1941 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1942 ;;;!! (defun mouse-scroll-left-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1943 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1944 ;;;!! (scroll-left nil))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1945 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1946 ;;;!! (defun mouse-scroll-right-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1947 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1948 ;;;!! (scroll-right nil))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1949 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1950 ;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1951 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1952 ;;;!! (move-to-column (1+ (car (mouse-coords click)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1953 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1954 ;;;!! (defun mouse-scroll-absolute-horizontally (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1955 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1956 ;;;!! (let* ((pos (car event))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1957 ;;;!! (position (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1958 ;;;!! (length (car (cdr pos))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1959 ;;;!! (set-window-hscroll (selected-window) 33)))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1960 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1961 ;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1962 ;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1963 ;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1964 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1965 ;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1966 ;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1967 ;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1968 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1969 ;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1970 ;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1971 ;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1972 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1973 ;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1974 ;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1975 ;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1976 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1977 ;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1978 ;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1979 ;;;!! 'mouse-scroll-absolute-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1980 ;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1981 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1982 ;;;!! (global-set-key [horizontal-slider mouse-1]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1983 ;;;!! 'mouse-scroll-move-cursor-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1984 ;;;!! (global-set-key [horizontal-slider mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1985 ;;;!! 'mouse-scroll-move-cursor-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1986 ;;;!! (global-set-key [horizontal-slider mouse-3]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1987 ;;;!! 'mouse-scroll-move-cursor-horizontally)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1988 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1989 ;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1990 ;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1991 ;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1992 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1993 ;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1994 ;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1995 ;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
1996 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1997 ;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1998 ;;;!! 'mouse-split-window-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1999 ;;;!! (global-set-key [mode-line S-mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2000 ;;;!! 'mouse-split-window-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2001 ;;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2002 ;;;!! 'mouse-split-window)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2003
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2004 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2005 ;;;!! ;;;; Here are experimental things being tested. Mouse events
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2006 ;;;!! ;;;; are of the form:
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2007 ;;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2008 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2009 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2010 ;;;!! ;;;; Dynamically track mouse coordinates
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2011 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2012 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2013 ;;;!! ;;(defun track-mouse (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2014 ;;;!! ;; "Track the coordinates, absolute and relative, of the mouse."
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2015 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2016 ;;;!! ;; (while mouse-grabbed
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2017 ;;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2018 ;;;!! ;; (abs-x (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2019 ;;;!! ;; (abs-y (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2020 ;;;!! ;; (relative-coordinate (coordinates-in-window-p
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2021 ;;;!! ;; (list (car pos) (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2022 ;;;!! ;; (selected-window))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2023 ;;;!! ;; (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2024 ;;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2025 ;;;!! ;; (car relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2026 ;;;!! ;; (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2027 ;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2028 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2029 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2030 ;;;!! ;; Dynamically put a box around the line indicated by point
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2031 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2032 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2033 ;;;!! ;;(require 'backquote)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2034 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2035 ;;;!! ;;(defun mouse-select-buffer-line (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2036 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2037 ;;;!! ;; (let ((relative-coordinate
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2038 ;;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2039 ;;;!! ;; (abs-y (car (cdr (car event)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2040 ;;;!! ;; (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2041 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2042 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2043 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2044 ;;;!! ;; (x-draw-rectangle
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2045 ;;;!! ;; (selected-screen)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2046 ;;;!! ;; abs-y 0
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2047 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2048 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2049 ;;;!! ;; (end-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2050 ;;;!! ;; (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2051 ;;;!! ;; (beginning-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2052 ;;;!! ;; (- (region-end) (region-beginning))) 1))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2053 ;;;!! ;; (sit-for 1)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2054 ;;;!! ;; (x-erase-rectangle (selected-screen))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2055 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2056 ;;;!! ;;(defvar last-line-drawn nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2057 ;;;!! ;;(defvar begin-delim "[^ \t]")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2058 ;;;!! ;;(defvar end-delim "[^ \t]")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2059 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2060 ;;;!! ;;(defun mouse-boxing (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2061 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2062 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2063 ;;;!! ;; (let ((screen (selected-screen)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2064 ;;;!! ;; (while (= (x-mouse-events) 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2065 ;;;!! ;; (let* ((pos (read-mouse-position screen))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2066 ;;;!! ;; (abs-x (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2067 ;;;!! ;; (abs-y (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2068 ;;;!! ;; (relative-coordinate
41611
64ee9a4a698e Converted backquote to the new style (in comments).
Sam Steingold <sds@gnu.org>
parents: 41034
diff changeset
2069 ;;;!! ;; (coordinates-in-window-p `(,abs-x ,abs-y)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2070 ;;;!! ;; (selected-window)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2071 ;;;!! ;; (begin-reg nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2072 ;;;!! ;; (end-reg nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2073 ;;;!! ;; (end-column nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2074 ;;;!! ;; (begin-column nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2075 ;;;!! ;; (if (and (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2076 ;;;!! ;; (or (not last-line-drawn)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2077 ;;;!! ;; (not (= last-line-drawn abs-y))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2078 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2079 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2080 ;;;!! ;; (if (= (following-char) 10)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2081 ;;;!! ;; ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2082 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2083 ;;;!! ;; (setq begin-reg (1- (re-search-forward end-delim)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2084 ;;;!! ;; (setq begin-column (1- (current-column)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2085 ;;;!! ;; (end-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2086 ;;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2087 ;;;!! ;; (setq end-column (1+ (current-column)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2088 ;;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2089 ;;;!! ;; (x-draw-rectangle screen
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2090 ;;;!! ;; (setq last-line-drawn abs-y)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2091 ;;;!! ;; begin-column
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2092 ;;;!! ;; (- end-column begin-column) 1))))))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2093 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2094 ;;;!! ;;(defun mouse-erase-box ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2095 ;;;!! ;; (interactive)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2096 ;;;!! ;; (if last-line-drawn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2097 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2098 ;;;!! ;; (x-erase-rectangle (selected-screen))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2099 ;;;!! ;; (setq last-line-drawn nil))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2100 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2101 ;;;!! ;;; (defun test-x-rectangle ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2102 ;;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2103 ;;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2104 ;;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2105 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2106 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2107 ;;;!! ;; Here is how to do double clicking in lisp. About to change.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2108 ;;;!! ;;
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2109 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2110 ;;;!! (defvar double-start nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2111 ;;;!! (defconst double-click-interval 300
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2112 ;;;!! "Max ticks between clicks")
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2113 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2114 ;;;!! (defun double-down (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2115 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2116 ;;;!! (if double-start
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2117 ;;;!! (let ((interval (- (nth 4 event) double-start)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2118 ;;;!! (if (< interval double-click-interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2119 ;;;!! (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2120 ;;;!! (backward-up-list 1)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2121 ;;;!! ;; (message "Interval %d" interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2122 ;;;!! (sleep-for 1)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2123 ;;;!! (setq double-start nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2124 ;;;!! (setq double-start (nth 4 event))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2125 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2126 ;;;!! (defun double-up (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2127 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2128 ;;;!! (and double-start
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2129 ;;;!! (> (- (nth 4 event ) double-start) double-click-interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2130 ;;;!! (setq double-start nil)))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2131 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2132 ;;;!! ;;; (defun x-test-doubleclick ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2133 ;;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2134 ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2135 ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2136 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2137 ;;;!! ;;
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
2138 ;;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar.
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2139 ;;;!! ;;
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2140 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2141 ;;;!! (defvar scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2142 ;;;!! (defconst scroll-speed 1)
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2143 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2144 ;;;!! (defun incr-scroll-down (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2145 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2146 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2147 ;;;!! (incremental-scroll scroll-speed))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2148 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2149 ;;;!! (defun incr-scroll-up (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2150 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2151 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2152 ;;;!! (incremental-scroll (- scroll-speed)))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2153 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2154 ;;;!! (defun incremental-scroll (n)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2155 ;;;!! (while (= (x-mouse-events) 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2156 ;;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2157 ;;;!! (scroll-down n)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2158 ;;;!! (sit-for 300 t)))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2159 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2160 ;;;!! (defun incr-scroll-stop (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2161 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2162 ;;;!! (message "Scrolled %d lines" scrolled-lines)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2163 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2164 ;;;!! (sleep-for 1))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2165 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2166 ;;;!! ;;; (defun x-testing-scroll ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2167 ;;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2168 ;;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2169 ;;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2170 ;;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2171 ;;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2172 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2173 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2174 ;;;!! ;; Some playthings suitable for picture mode? They need work.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2175 ;;;!! ;;
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2176 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2177 ;;;!! (defun mouse-kill-rectangle (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2178 ;;;!! "Kill the rectangle between point and the mouse cursor."
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2179 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2180 ;;;!! (let ((point-save (point)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2181 ;;;!! (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2182 ;;;!! (mouse-set-point event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2183 ;;;!! (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2184 ;;;!! (if (> point-save (point))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2185 ;;;!! (kill-rectangle (point) point-save)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2186 ;;;!! (kill-rectangle point-save (point))))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2187 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2188 ;;;!! (defun mouse-open-rectangle (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2189 ;;;!! "Kill the rectangle between point and the mouse cursor."
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2190 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2191 ;;;!! (let ((point-save (point)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2192 ;;;!! (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2193 ;;;!! (mouse-set-point event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2194 ;;;!! (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2195 ;;;!! (if (> point-save (point))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2196 ;;;!! (open-rectangle (point) point-save)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2197 ;;;!! (open-rectangle point-save (point))))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2198 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2199 ;;;!! ;; Must be a better way to do this.
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2200 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2201 ;;;!! (defun mouse-multiple-insert (n char)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2202 ;;;!! (while (> n 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2203 ;;;!! (insert char)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2204 ;;;!! (setq n (1- n))))
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2205 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2206 ;;;!! ;; What this could do is not finalize until button was released.
40268
3b6c70f1fe6c (mouse-buffer-menu-mode-groups): Added "Version Control" group.
Sam Steingold <sds@gnu.org>
parents: 38982
diff changeset
2207 ;;;!!
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2208 ;;;!! (defun mouse-move-text (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2209 ;;;!! "Move text from point to cursor position, inserting spaces."
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2210 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2211 ;;;!! (let* ((relative-coordinate
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2212 ;;;!! (coordinates-in-window-p (car event) (selected-window))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2213 ;;;!! (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2214 ;;;!! (cond ((> (current-column) (car relative-coordinate))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2215 ;;;!! (delete-char
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2216 ;;;!! (- (car relative-coordinate) (current-column))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2217 ;;;!! ((< (current-column) (car relative-coordinate))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2218 ;;;!! (mouse-multiple-insert
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2219 ;;;!! (- (car relative-coordinate) (current-column)) " "))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2220 ;;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2221
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2222 ;; Choose a completion with the mouse.
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2223
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2224 (defun mouse-choose-completion (event)
4371
fb0e37e7afae (mouse-choose-completion): Actually choose that alternative,
Richard M. Stallman <rms@gnu.org>
parents: 4294
diff changeset
2225 "Click on an alternative in the `*Completions*' buffer to choose it."
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2226 (interactive "e")
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
2227 ;; Give temporary modes such as isearch a chance to turn off.
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
2228 (run-hooks 'mouse-leave-buffer-hook)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
2229 (let ((buffer (window-buffer))
8477
f4aa7a288cb6 (mouse-choose-completion): Pass completion-base-size value
Richard M. Stallman <rms@gnu.org>
parents: 8460
diff changeset
2230 choice
f4aa7a288cb6 (mouse-choose-completion): Pass completion-base-size value
Richard M. Stallman <rms@gnu.org>
parents: 8460
diff changeset
2231 base-size)
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2232 (save-excursion
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2233 (set-buffer (window-buffer (posn-window (event-start event))))
6163
f349bcb0ff59 (mouse-choose-completion): Use that as the buffer to edit.
Richard M. Stallman <rms@gnu.org>
parents: 6090
diff changeset
2234 (if completion-reference-buffer
f349bcb0ff59 (mouse-choose-completion): Use that as the buffer to edit.
Richard M. Stallman <rms@gnu.org>
parents: 6090
diff changeset
2235 (setq buffer completion-reference-buffer))
8477
f4aa7a288cb6 (mouse-choose-completion): Pass completion-base-size value
Richard M. Stallman <rms@gnu.org>
parents: 8460
diff changeset
2236 (setq base-size completion-base-size)
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2237 (save-excursion
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2238 (goto-char (posn-point (event-start event)))
7593
a837cfdcf7c0 (mouse-choose-completion):
Richard M. Stallman <rms@gnu.org>
parents: 7588
diff changeset
2239 (let (beg end)
8204
f5c8a4e8c4a5 (mouse-choose-completion): Use mouse-face properties to find string to use.
Richard M. Stallman <rms@gnu.org>
parents: 8200
diff changeset
2240 (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>
parents: 8200
diff changeset
2241 (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>
parents: 8200
diff changeset
2242 (if (null beg)
f5c8a4e8c4a5 (mouse-choose-completion): Use mouse-face properties to find string to use.
Richard M. Stallman <rms@gnu.org>
parents: 8200
diff changeset
2243 (error "No completion here"))
f5c8a4e8c4a5 (mouse-choose-completion): Use mouse-face properties to find string to use.
Richard M. Stallman <rms@gnu.org>
parents: 8200
diff changeset
2244 (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>
parents: 8268
diff changeset
2245 (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>
parents: 8268
diff changeset
2246 (point-max)))
67779
01ba52243e5f (mouse-choose-completion): Replace `buffer-substring' with
Juri Linkov <juri@jurta.org>
parents: 67524
diff changeset
2247 (setq choice (buffer-substring-no-properties beg end)))))
6231
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
2248 (let ((owindow (selected-window)))
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
2249 (select-window (posn-window (event-start event)))
7794
10ed4c75936b (mouse-choose-completion): If *Completion* is a special
Richard M. Stallman <rms@gnu.org>
parents: 7637
diff changeset
2250 (if (and (one-window-p t 'selected-frame)
10ed4c75936b (mouse-choose-completion): If *Completion* is a special
Richard M. Stallman <rms@gnu.org>
parents: 7637
diff changeset
2251 (window-dedicated-p (selected-window)))
10ed4c75936b (mouse-choose-completion): If *Completion* is a special
Richard M. Stallman <rms@gnu.org>
parents: 7637
diff changeset
2252 ;; This is a special buffer's frame
10ed4c75936b (mouse-choose-completion): If *Completion* is a special
Richard M. Stallman <rms@gnu.org>
parents: 7637
diff changeset
2253 (iconify-frame (selected-frame))
10ed4c75936b (mouse-choose-completion): If *Completion* is a special
Richard M. Stallman <rms@gnu.org>
parents: 7637
diff changeset
2254 (or (window-dedicated-p (selected-window))
10ed4c75936b (mouse-choose-completion): If *Completion* is a special
Richard M. Stallman <rms@gnu.org>
parents: 7637
diff changeset
2255 (bury-buffer)))
6231
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
2256 (select-window owindow))
8477
f4aa7a288cb6 (mouse-choose-completion): Pass completion-base-size value
Richard M. Stallman <rms@gnu.org>
parents: 8460
diff changeset
2257 (choose-completion-string choice buffer base-size)))
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
2258
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2259 ;; Font selection.
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
2260
4294
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
2261 (defun font-menu-add-default ()
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
2262 (let* ((default (cdr (assq 'font (frame-parameters (selected-frame)))))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
2263 (font-alist x-fixed-font-alist)
4563
b9118969ce28 (font-menu-add-default): Use list, not cons, for new elt.
Richard M. Stallman <rms@gnu.org>
parents: 4562
diff changeset
2264 (elt (or (assoc "Misc" font-alist) (nth 1 font-alist))))
4294
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
2265 (if (assoc "Default" elt)
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
2266 (delete (assoc "Default" elt) elt))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
2267 (setcdr elt
25547
2992a7953ac4 (font-menu-add-default): Simplify code.
Richard M. Stallman <rms@gnu.org>
parents: 25288
diff changeset
2268 (cons (list "Default" default)
4294
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
2269 (cdr elt)))))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
2270
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2271 (defvar x-fixed-font-alist
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2272 '("Font menu"
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2273 ("Misc"
8460
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2274 ;; For these, we specify the pixel height and width.
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2275 ("fixed" "fixed")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2276 ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2277 ("6x12"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2278 "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2279 ("6x13"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2280 "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2281 ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2282 ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2283 ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2284 ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2285 ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2286 ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2287 ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24")
4274
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
2288 ("")
8487
0a77d1dbae03 (x-fixed-font-alist): Add clean 5x8 and clean 6x8.
Richard M. Stallman <rms@gnu.org>
parents: 8477
diff changeset
2289 ("clean 5x8"
0a77d1dbae03 (x-fixed-font-alist): Add clean 5x8 and clean 6x8.
Richard M. Stallman <rms@gnu.org>
parents: 8477
diff changeset
2290 "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1")
0a77d1dbae03 (x-fixed-font-alist): Add clean 5x8 and clean 6x8.
Richard M. Stallman <rms@gnu.org>
parents: 8477
diff changeset
2291 ("clean 6x8"
0a77d1dbae03 (x-fixed-font-alist): Add clean 5x8 and clean 6x8.
Richard M. Stallman <rms@gnu.org>
parents: 8477
diff changeset
2292 "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1")
8460
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2293 ("clean 8x8"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2294 "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2295 ("clean 8x10"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2296 "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2297 ("clean 8x14"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2298 "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2299 ("clean 8x16"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2300 "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1")
4274
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
2301 ("")
25097
65612dade7f5 (x-fixed-font-alist): Add lucidasanstypewriter.
Dave Love <fx@gnu.org>
parents: 24962
diff changeset
2302 ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1")
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2303 ;;; We don't seem to have these; who knows what they are.
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2304 ;;; ("fg-18" "fg-18")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2305 ;;; ("fg-25" "fg-25")
25097
65612dade7f5 (x-fixed-font-alist): Add lucidasanstypewriter.
Dave Love <fx@gnu.org>
parents: 24962
diff changeset
2306 ("lucidasanstypewriter-12" "-b&h-lucidatypewriter-medium-r-normal-sans-*-120-*-*-*-*-iso8859-1")
65612dade7f5 (x-fixed-font-alist): Add lucidasanstypewriter.
Dave Love <fx@gnu.org>
parents: 24962
diff changeset
2307 ("lucidasanstypewriter-bold-14" "-b&h-lucidatypewriter-bold-r-normal-sans-*-140-*-*-*-*-iso8859-1")
65612dade7f5 (x-fixed-font-alist): Add lucidasanstypewriter.
Dave Love <fx@gnu.org>
parents: 24962
diff changeset
2308 ("lucidasanstypewriter-bold-24"
65612dade7f5 (x-fixed-font-alist): Add lucidasanstypewriter.
Dave Love <fx@gnu.org>
parents: 24962
diff changeset
2309 "-b&h-lucidatypewriter-bold-r-normal-sans-*-240-*-*-*-*-iso8859-1")
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2310 ;;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2311 ;;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
25097
65612dade7f5 (x-fixed-font-alist): Add lucidasanstypewriter.
Dave Love <fx@gnu.org>
parents: 24962
diff changeset
2312 )
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2313 ("Courier"
8460
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
2314 ;; For these, we specify the point height.
3231
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2315 ("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2316 ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2317 ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2318 ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2319 ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2320 ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2321 ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2322 ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2323 ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2324 ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2325 ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2326 ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2327 ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2328 ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2329 ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2330 ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2331 ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2332 ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2333 ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2334 ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2335 ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2336 ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2337 ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1")
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
2338 ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1"))
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2339 )
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2340 "X fonts suitable for use in Emacs.")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2341
6867
0f4c8109274a (x-fixed-font-alist): Give multiple names for try for certain fonts.
Richard M. Stallman <rms@gnu.org>
parents: 6548
diff changeset
2342 (defun mouse-set-font (&rest fonts)
17008
3a99b530ad9a (mouse-set-font): Handle fontset.
Karl Heuer <kwzh@gnu.org>
parents: 16989
diff changeset
2343 "Select an emacs font from a list of known good fonts and fontsets."
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2344 (interactive
45570
1739a350f81c (mouse-set-font): Avoid misleading error message if user makes no selection.
Richard M. Stallman <rms@gnu.org>
parents: 44474
diff changeset
2345 (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>
parents: 44474
diff changeset
2346 (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>
parents: 44474
diff changeset
2347 (x-popup-menu
58837
e3c6ff0922c2 (mouse-set-font): Handle the case where the command was not invoked
Luc Teirlinck <teirllm@auburn.edu>
parents: 58194
diff changeset
2348 (if (listp last-nonmenu-event)
e3c6ff0922c2 (mouse-set-font): Handle the case where the command was not invoked
Luc Teirlinck <teirllm@auburn.edu>
parents: 58194
diff changeset
2349 last-nonmenu-event
e3c6ff0922c2 (mouse-set-font): Handle the case where the command was not invoked
Luc Teirlinck <teirllm@auburn.edu>
parents: 58194
diff changeset
2350 (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>
parents: 44474
diff changeset
2351 ;; 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>
parents: 44474
diff changeset
2352 (append x-fixed-font-alist (list (generate-fontset-menu))))))
6914
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
2353 (if fonts
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
2354 (let (font)
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
2355 (while fonts
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
2356 (condition-case nil
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
2357 (progn
7021
da5dc735eb50 (mouse-set-font): Simply call set-default-font.
Richard M. Stallman <rms@gnu.org>
parents: 6923
diff changeset
2358 (set-default-font (car fonts))
6914
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
2359 (setq font (car fonts))
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
2360 (setq fonts nil))
7021
da5dc735eb50 (mouse-set-font): Simply call set-default-font.
Richard M. Stallman <rms@gnu.org>
parents: 6923
diff changeset
2361 (error
da5dc735eb50 (mouse-set-font): Simply call set-default-font.
Richard M. Stallman <rms@gnu.org>
parents: 6923
diff changeset
2362 (setq fonts (cdr fonts)))))
6914
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
2363 (if (null font)
45570
1739a350f81c (mouse-set-font): Avoid misleading error message if user makes no selection.
Richard M. Stallman <rms@gnu.org>
parents: 44474
diff changeset
2364 (error "Font not found")))))
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
2365
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
2366 ;;; Bindings for mouse commands.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
2367
2799
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
2368 (define-key global-map [down-mouse-1] 'mouse-drag-region)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2369 (global-set-key [mouse-1] 'mouse-set-point)
2799
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
2370 (global-set-key [drag-mouse-1] 'mouse-set-region)
1057
d9775f33488d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1056
diff changeset
2371
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
2372 ;; These are tested for in mouse-drag-region.
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
2373 (global-set-key [double-mouse-1] 'mouse-set-point)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
2374 (global-set-key [triple-mouse-1] 'mouse-set-point)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
2375
53133
50717ae10f39 Bind mouse-1 on left-fringe and right-fringe to mouse-set-point so
Kim F. Storm <storm@cua.dk>
parents: 52405
diff changeset
2376 ;; Clicking on the fringes causes hscrolling:
50717ae10f39 Bind mouse-1 on left-fringe and right-fringe to mouse-set-point so
Kim F. Storm <storm@cua.dk>
parents: 52405
diff changeset
2377 (global-set-key [left-fringe mouse-1] 'mouse-set-point)
50717ae10f39 Bind mouse-1 on left-fringe and right-fringe to mouse-set-point so
Kim F. Storm <storm@cua.dk>
parents: 52405
diff changeset
2378 (global-set-key [right-fringe mouse-1] 'mouse-set-point)
50717ae10f39 Bind mouse-1 on left-fringe and right-fringe to mouse-set-point so
Kim F. Storm <storm@cua.dk>
parents: 52405
diff changeset
2379
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2380 (global-set-key [mouse-2] 'mouse-yank-at-click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2381 (global-set-key [mouse-3] 'mouse-save-then-kill)
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
2382
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2383 ;; By binding these to down-going events, we let the user use the up-going
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2384 ;; event to make the selection, saving a click.
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
2385 (global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
2386 (if (not (eq system-type 'ms-dos))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
2387 (global-set-key [S-down-mouse-1] 'mouse-set-font))
9753
00144934b449 Put mouse-set-font on C-down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 9572
diff changeset
2388 ;; C-down-mouse-2 is bound in facemenu.el.
30328
7ce202715b72 (popup-menu): Allow a list of keymaps for menu arg.
Dave Love <fx@gnu.org>
parents: 30312
diff changeset
2389 (global-set-key [C-down-mouse-3] 'mouse-popup-menubar-stuff)
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
2390
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
2391
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
2392 ;; Replaced with dragging mouse-1
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
2393 ;; (global-set-key [S-mouse-1] 'mouse-set-mark)
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
2394
32327
140165e85530 ([header-line mouse-1]): Bind to mouse-select-window.
Eli Zaretskii <eliz@gnu.org>
parents: 32319
diff changeset
2395 ;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
140165e85530 ([header-line mouse-1]): Bind to mouse-select-window.
Eli Zaretskii <eliz@gnu.org>
parents: 32319
diff changeset
2396 ;; vertical-line prevents Emacs from signaling an error when the mouse
140165e85530 ([header-line mouse-1]): Bind to mouse-select-window.
Eli Zaretskii <eliz@gnu.org>
parents: 32319
diff changeset
2397 ;; button is released after dragging these lines, on non-toolkit
140165e85530 ([header-line mouse-1]): Bind to mouse-select-window.
Eli Zaretskii <eliz@gnu.org>
parents: 32319
diff changeset
2398 ;; versions.
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
2399 (global-set-key [mode-line mouse-1] 'mouse-select-window)
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
2400 (global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
2401 (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
25618
ed0f7bf2cfc7 (mouse-drag-mode-line-1): Extension of former
Gerd Moellmann <gerd@gnu.org>
parents: 25547
diff changeset
2402 (global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
32327
140165e85530 ([header-line mouse-1]): Bind to mouse-select-window.
Eli Zaretskii <eliz@gnu.org>
parents: 32319
diff changeset
2403 (global-set-key [header-line mouse-1] 'mouse-select-window)
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
2404 (global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
2405 (global-set-key [mode-line mouse-3] 'mouse-delete-window)
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
2406 (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
8174
0c7bcd40a21e ([vertical-scroll-bar C-mouse-2]): Split the window.
Richard M. Stallman <rms@gnu.org>
parents: 8135
diff changeset
2407 (global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
8268
3ff0307b8c0d ([vertical-line C-mouse-2]): Bind it as in a scroll bar.
Richard M. Stallman <rms@gnu.org>
parents: 8255
diff changeset
2408 (global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
2409 (global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
2410 (global-set-key [vertical-line mouse-1] 'mouse-select-window)
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
2411
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
2412 (provide 'mouse)
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
2413
25288
65dbd144132d Provide `mldrag' for compatibility.
Dave Love <fx@gnu.org>
parents: 25097
diff changeset
2414 ;; This file contains the functionality of the old mldrag.el.
65dbd144132d Provide `mldrag' for compatibility.
Dave Love <fx@gnu.org>
parents: 25097
diff changeset
2415 (defalias 'mldrag-drag-mode-line 'mouse-drag-mode-line)
65dbd144132d Provide `mldrag' for compatibility.
Dave Love <fx@gnu.org>
parents: 25097
diff changeset
2416 (defalias 'mldrag-drag-vertical-line 'mouse-drag-vertical-line)
29353
42c2692d3933 Add a version to the obsoletions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29344
diff changeset
2417 (make-obsolete 'mldrag-drag-mode-line 'mouse-drag-mode-line "21.1")
42c2692d3933 Add a version to the obsoletions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29344
diff changeset
2418 (make-obsolete 'mldrag-drag-vertical-line 'mouse-drag-vertical-line "21.1")
25288
65dbd144132d Provide `mldrag' for compatibility.
Dave Love <fx@gnu.org>
parents: 25097
diff changeset
2419 (provide 'mldrag)
65dbd144132d Provide `mldrag' for compatibility.
Dave Love <fx@gnu.org>
parents: 25097
diff changeset
2420
65623
fcbaf6135d19 (mouse-drag-mode-line-1, mouse-drag-vertical-line):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 65498
diff changeset
2421 ;; arch-tag: 9a710ce1-914a-4923-9b81-697f7bf82ab3
659
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
2422 ;;; mouse.el ends here