annotate lisp/mouse.el @ 22477:9bc88c123895 gcc-2_8_1-980627 gcc-2_8_1-980705 gcc-2_8_1-980718 libc-980614 libc-980615 libc-980616 libc-980617 libc-980618 libc-980619 libc-980620 libc-980621 libc-980622 libc-980623 libc-980624 libc-980625 libc-980626 libc-980627 libc-980628 libc-980629 libc-980630 libc-980701 libc-980702 libc-980703 libc-980704 libc-980705 libc-980706 libc-980707 libc-980708 libc-980709 libc-980710 libc-980711 libc-980712 libc-980713 libc-980714 libc-980715 libc-980716 libc-980717 libc-980718 libc-980719

(sun4H:SunOS:5.*:*): New case.
author Richard Kenner <kenner@gnu.org>
date Sat, 13 Jun 1998 19:51:10 +0000
parents 6655c426d447
children bd706438b50c
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
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
3 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
840
113281b361ec *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 791
diff changeset
4
791
203c23c9f22c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 758
diff changeset
5 ;; Maintainer: FSF
203c23c9f22c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 758
diff changeset
6 ;; Keywords: hardware
203c23c9f22c *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 758
diff changeset
7
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
8 ;; This file is part of GNU Emacs.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
10 ;; 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
11 ;; 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
12 ;; the Free Software Foundation; either version 2, or (at your option)
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
13 ;; any later version.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
15 ;; 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
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
18 ;; GNU General Public License for more details.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19
13337
84acc3adcd63 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 13307
diff changeset
20 ;; 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
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
7db5b89b78b6 (mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
parents: 13872
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
7db5b89b78b6 (mouse-drag-region, mouse-drag-secondary): Bind echo-keystrokes to 0.
Richard M. Stallman <rms@gnu.org>
parents: 13872
diff changeset
23 ;; Boston, MA 02111-1307, USA.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
2308
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
25 ;;; Commentary:
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
26
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
27 ;; 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
28 ;; 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
29 ;; 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
30 ;;
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
31 ;; The code is rather X-dependent.
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
32
2232
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2070
diff changeset
33 ;;; Code:
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2070
diff changeset
34
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
35 ;;; Utility functions.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
36
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
37 ;;; Indent track-mouse like progn.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
38 (put 'track-mouse 'lisp-indent-function 0)
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
40 (defcustom mouse-yank-at-point nil
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
41 "*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
42 :type 'boolean
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
43 :group 'mouse)
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
44
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
45 ;; 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
46
16621
042bf1d82a14 (mouse-major-mode-menu): Propagate prefix arg
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
47 (defun 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
48 "Pop up a mode-specific menu of mouse commands."
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
49 ;; 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
50 ;; 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
51 (interactive "@e\nP")
21953
6655c426d447 (mouse-major-mode-menu): Run activate-menubar-hook here.
Richard M. Stallman <rms@gnu.org>
parents: 21685
diff changeset
52 ;; Let the mode update its menus first.
6655c426d447 (mouse-major-mode-menu): Run activate-menubar-hook here.
Richard M. Stallman <rms@gnu.org>
parents: 21685
diff changeset
53 (run-hooks 'activate-menubar-hook)
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
54 (let (;; This is where mouse-major-mode-menu-prefix
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
55 ;; returns the prefix we should use (after menu-bar).
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
56 ;; It is either nil or (SOME-SYMBOL).
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
57 (mouse-major-mode-menu-prefix nil)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
58 ;; Make a keymap in which our last command leads to a menu
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
59 (newmap (make-sparse-keymap (concat mode-name " Mode")))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
60 result)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
61 ;; Make our menu inherit from the desired keymap
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
62 ;; which we want to display as the menu now.
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
63 (set-keymap-parent newmap
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
64 (mouse-major-mode-menu-1
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
65 (and (current-local-map)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
66 (lookup-key (current-local-map) [menu-bar]))))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
67 (setq result (x-popup-menu t (list newmap)))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
68 (if result
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
69 (let ((command (key-binding
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
70 (apply 'vector (append '(menu-bar)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
71 mouse-major-mode-menu-prefix
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
72 result)))))
16621
042bf1d82a14 (mouse-major-mode-menu): Propagate prefix arg
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
73 ;; Clear out echoing, which perhaps shows a prefix arg.
042bf1d82a14 (mouse-major-mode-menu): Propagate prefix arg
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
74 (message "")
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
75 (if command
16621
042bf1d82a14 (mouse-major-mode-menu): Propagate prefix arg
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
76 (progn
042bf1d82a14 (mouse-major-mode-menu): Propagate prefix arg
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
77 (setq prefix-arg prefix)
042bf1d82a14 (mouse-major-mode-menu): Propagate prefix arg
Richard M. Stallman <rms@gnu.org>
parents: 16590
diff changeset
78 (command-execute command)))))))
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
79
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
80 ;; 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
81 ;;;(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
82 ;;; (and (eq (car menu) 'keymap)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
83 ;;; (x-popup-menu nil menu))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
84 ;;; (while menu
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
85 ;;; (and (consp (car menu))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
86 ;;; (consp (cdr (car menu)))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
87 ;;; (let ((tail (cdr (car menu))))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
88 ;;; (while (and (consp tail)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
89 ;;; (not (eq (car tail) 'keymap)))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
90 ;;; (setq tail (cdr tail)))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
91 ;;; (if (consp tail)
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
92 ;;; (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
93 ;;; (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
94
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
95 ;; 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
96 ;; 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
97 ;; return just that menu.
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
98 ;; 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
99 (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
100 (if menubar
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
101 (let ((tail menubar)
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
102 submap)
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
103 (while tail
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
104 (if (consp (car tail))
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
105 (if submap
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
106 (setq submap t)
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
107 (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
108 (setq tail (cdr tail)))
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
109 (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
110 menubar
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
111 (setq mouse-major-mode-menu-prefix (list (car submap)))
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
112 (cdr (cdr submap))))))
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
113
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
114 ;; 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
115
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
116 (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
117 (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
118 (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
119 (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
120 (error "Minibuffer window is not active")))
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
121 ;; 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
122 (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
123
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
124 (defun mouse-delete-window (click)
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
125 "Delete the window you click on.
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
126 This must be bound to a mouse click."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
127 (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
128 (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
129 (delete-window (posn-window (event-start click))))
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
130
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
131 (defun mouse-select-window (click)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
132 "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
133 (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
134 (mouse-minibuffer-check click)
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
135 (let ((oframe (selected-frame))
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
136 (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
137 (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
138 (raise-frame frame)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
139 (select-frame frame)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
140 (or (eq frame oframe)
16087
26b552f014ff (mouse-select-window): Don't call unfocus-frame.
Richard M. Stallman <rms@gnu.org>
parents: 16016
diff changeset
141 (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
142
1421
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
143 (defun mouse-tear-off-window (click)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
144 "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
145 (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
146 (mouse-minibuffer-check click)
1421
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
147 (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
148 (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
149 (frame (make-frame)))
1421
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
150 (select-frame frame)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
151 (switch-to-buffer buf)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
152 (delete-window window)))
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
153
1363
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
154 (defun mouse-delete-other-windows ()
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
155 "Delete all window 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
156 (interactive "@")
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 (delete-other-windows))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
159 (defun mouse-split-window-vertically (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
160 "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
161 The window is split at the line clicked on.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
162 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
163 (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
164 (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
165 (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
166 (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
167 (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
168 (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
169 (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
170 (if (< last-line first-line)
8426
3abe02e03dc8 Capitalize some error messages.
Richard M. Stallman <rms@gnu.org>
parents: 8381
diff changeset
171 (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
172 (split-window-vertically
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
173 (min (max new-height first-line) last-line))))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
175 (defun mouse-split-window-horizontally (click)
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
176 "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
177 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
178 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
179 (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
180 (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
181 (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
182 (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
183 (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
184 (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
185 (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
186 (if (< last-col first-col)
8426
3abe02e03dc8 Capitalize some error messages.
Richard M. Stallman <rms@gnu.org>
parents: 8381
diff changeset
187 (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
188 (split-window-horizontally
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
189 (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
190
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
191 (defun mouse-drag-mode-line (start-event)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
192 "Change the height of a window by dragging on the mode line."
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
193 (interactive "e")
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
194 ;; 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
195 (run-hooks 'mouse-leave-buffer-hook)
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
196 (let ((done nil)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
197 (echo-keystrokes 0)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
198 (start-event-frame (window-frame (car (car (cdr start-event)))))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
199 (start-event-window (car (car (cdr start-event))))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
200 (start-nwindows (count-windows t))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
201 (old-selected-window (selected-window))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
202 should-enlarge-minibuffer
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
203 event mouse minibuffer y top bot edges wconfig params growth)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
204 (setq params (frame-parameters))
16636
ba78d234fe6c (mouse-drag-mode-line): Don't get error
Richard M. Stallman <rms@gnu.org>
parents: 16621
diff changeset
205 (setq minibuffer (cdr (assq 'minibuffer params)))
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
206 (track-mouse
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
207 (progn
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
208 ;; 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
209 ;; 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
210 ;; 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
211 (select-window start-event-window)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
212 ;; 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
213 ;; 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
214 (setq should-enlarge-minibuffer
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
215 (and minibuffer
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
216 (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
217 (= (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
218 (nth 3 (window-edges)))))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
219 ;; 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
220 ;; the mouse.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
221 (while (not done)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
222 (setq event (read-event)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
223 mouse (mouse-position))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
224 ;; do nothing if
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
225 ;; - 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
226 ;; - 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
227 ;; - 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
228 ;; drag if
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
229 ;; - 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
230 ;; - 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
231 ;; (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
232 ;; quit if
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
233 ;; - 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
234 ;; unknown event.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
235 (cond ((integerp event)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
236 (setq done t))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
237 ((eq (car event) 'switch-frame)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
238 nil)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
239 ((not (memq (car event)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
240 '(mouse-movement scroll-bar-movement)))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
241 (if (consp event)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
242 (setq unread-command-events
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
243 (cons event unread-command-events)))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
244 (setq done t))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
245 ((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
246 nil)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
247 ((null (car (cdr mouse)))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
248 nil)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
249 (t
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
250 (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
251 edges (window-edges)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
252 top (nth 1 edges)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
253 bot (nth 3 edges))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
254 ;; scale back a move that would make the
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
255 ;; window too short.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
256 (cond ((< (- y top -1) window-min-height)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
257 (setq y (+ top window-min-height -1))))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
258 ;; compute size change needed
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
259 (setq growth (- y bot -1)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
260 wconfig (current-window-configuration))
16636
ba78d234fe6c (mouse-drag-mode-line): Don't get error
Richard M. Stallman <rms@gnu.org>
parents: 16621
diff changeset
261 ;; Check for an error case.
ba78d234fe6c (mouse-drag-mode-line): Don't get error
Richard M. Stallman <rms@gnu.org>
parents: 16621
diff changeset
262 (if (and (/= growth 0)
ba78d234fe6c (mouse-drag-mode-line): Don't get error
Richard M. Stallman <rms@gnu.org>
parents: 16621
diff changeset
263 (not minibuffer)
ba78d234fe6c (mouse-drag-mode-line): Don't get error
Richard M. Stallman <rms@gnu.org>
parents: 16621
diff changeset
264 (one-window-p t))
ba78d234fe6c (mouse-drag-mode-line): Don't get error
Richard M. Stallman <rms@gnu.org>
parents: 16621
diff changeset
265 (error "Attempt to resize sole window"))
8519
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
266 ;; grow/shrink minibuffer?
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
267 (if should-enlarge-minibuffer
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
268 (progn
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
269 ;; yes. briefly select minibuffer so
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
270 ;; enlarge-window will affect the
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
271 ;; correct window.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
272 (select-window minibuffer)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
273 ;; scale back shrinkage if it would
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
274 ;; make the minibuffer less than 1
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
275 ;; line tall.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
276 (if (and (> growth 0)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
277 (< (- (window-height minibuffer)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
278 growth)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
279 1))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
280 (setq growth (1- (window-height minibuffer))))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
281 (enlarge-window (- growth))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
282 (select-window start-event-window))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
283 ;; no. grow/shrink the selected window
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
284 (enlarge-window growth))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
285 ;; 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
286 ;; 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
287 ;; short, rescind the change.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
288 ;;
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
289 ;; 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
290 ;; from a window above this one, rescind the
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
291 ;; change, but only if we didn't grow/srhink
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
292 ;; 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
293 ;; 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
294 ;; around it.
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
295 (if (or (/= start-nwindows (count-windows t))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
296 (and (not should-enlarge-minibuffer)
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
297 (/= top (nth 1 (window-edges)))))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
298 (set-window-configuration wconfig)))))))))
7802e26b3bfd (mouse-drag-mode-line): New function (from mldrag.el,
Richard M. Stallman <rms@gnu.org>
parents: 8487
diff changeset
299
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
300 (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
301 "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
302 (interactive "e")
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
303 ;; 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
304 (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
305 (let* ((done nil)
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
306 (echo-keystrokes 0)
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
307 (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
308 (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
309 (start-nwindows (count-windows t))
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
310 (old-selected-window (selected-window))
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
311 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
312 (which-side
988d8082f292 (mouse-drag-vertical-line): Properly determine which
Richard M. Stallman <rms@gnu.org>
parents: 20124
diff changeset
313 (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
314 'right)))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
315 (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
316 (error "Attempt to resize sole ordinary window"))
20124
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
317 (if (eq which-side 'left)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
318 (if (= (nth 0 (window-edges start-event-window)) 0)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
319 (error "Attempt to drag leftmost scrollbar"))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
320 (if (= (nth 2 (window-edges start-event-window))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
321 (frame-width start-event-frame))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
322 (error "Attempt to drag rightmost scrollbar")))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
323 (track-mouse
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
324 (progn
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
325 ;; 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
326 ;; 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
327 ;; 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
328 (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
329 ;; 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
330 ;; the mouse.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
331 (while (not done)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
332 (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
333 mouse (mouse-position))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
334 ;; do nothing if
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
335 ;; - 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
336 ;; - 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
337 ;; - 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
338 ;; drag if
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
339 ;; - 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
340 ;; - 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
341 ;; (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
342 ;; quit if
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
343 ;; - 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
344 ;; unknown event.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
345 (cond ((integerp event)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
346 (setq done t))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
347 ((eq (car event) 'switch-frame)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
348 nil)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
349 ((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
350 '(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
351 (if (consp event)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
352 (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
353 (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
354 (setq done t))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
355 ((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
356 nil)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
357 ((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
358 nil)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
359 (t
20124
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
360 (save-selected-window
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
361 ;; If the scroll bar is on the window's left,
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
362 ;; adjust the window on the left.
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
363 (if (eq which-side 'left)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
364 (select-window (previous-window)))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
365 (setq x (- (car (cdr mouse))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
366 (if (eq which-side 'left) 2 0))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
367 edges (window-edges)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
368 left (nth 0 edges)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
369 right (nth 2 edges))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
370 ;; 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
371 ;; window too thin.
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
372 (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
373 (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
374 ;; compute size change needed
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
375 (setq growth (- x right -1)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
376 wconfig (current-window-configuration))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
377 (enlarge-window growth t)
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
378 ;; if this window's growth caused another
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
379 ;; window to be deleted because it was too
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
380 ;; thin, rescind the change.
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
381 ;;
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
382 ;; if size change caused space to be stolen
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
383 ;; from a window to the left of this one,
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
384 ;; rescind the change.
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
385 (if (or (/= start-nwindows (count-windows t))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
386 (/= left (nth 0 (window-edges))))
ecae234a33bb (mouse-drag-vertical-line): Handle left-side scroll bars.
Karl Heuer <kwzh@gnu.org>
parents: 18689
diff changeset
387 (set-window-configuration wconfig))))))))))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
388
4554
cf541ed1fed8 (mouse-set-point): Use event-end, not event-start.
Richard M. Stallman <rms@gnu.org>
parents: 4532
diff changeset
389 (defun mouse-set-point (event)
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
390 "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
391 This should be bound to a mouse click event type."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
392 (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
393 (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
394 ;; 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
395 ;; If EVENT is a click, event-end and event-start give same value.
cf541ed1fed8 (mouse-set-point): Use event-end, not event-start.
Richard M. Stallman <rms@gnu.org>
parents: 4532
diff changeset
396 (let ((posn (event-end event)))
8426
3abe02e03dc8 Capitalize some error messages.
Richard M. Stallman <rms@gnu.org>
parents: 8381
diff changeset
397 (if (not (windowp (posn-window posn)))
3abe02e03dc8 Capitalize some error messages.
Richard M. Stallman <rms@gnu.org>
parents: 8381
diff changeset
398 (error "Cursor not in text area of window"))
1363
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
399 (select-window (posn-window posn))
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
400 (if (numberp (posn-point posn))
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
401 (goto-char (posn-point posn)))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
403 (defvar mouse-last-region-beg nil)
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
404 (defvar mouse-last-region-end nil)
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
405 (defvar mouse-last-region-tick nil)
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
406
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
407 (defun mouse-region-match ()
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
408 "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
409 (and (mark t) mark-active
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
410 (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
411 (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
412 (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
413
1420
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
414 (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
415 "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
416 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
417 (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
418 (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
419 (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
420 (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
421 (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
422 (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
423 (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
424 ;; 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
425 ;; 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
426 (or transient-mark-mode
16590
a0cfcb9f8033 Use w32 instead of ms-windows for window-system symbol
Geoff Voelker <voelker@cs.washington.edu>
parents: 16318
diff changeset
427 (memq (framep (selected-frame)) '(x pc w32))
2799
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
428 (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
429 (push-mark)
2802
02c75b605550 (mouse-set-region): Call set-mark to activate mark.
Richard M. Stallman <rms@gnu.org>
parents: 2799
diff changeset
430 (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
431 (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
432 (goto-char (posn-point end)))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
433 ;; 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
434 ;; 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
435 ;; Ignore last-command so we don't append to a preceding kill.
21194
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
436 (let (this-command last-command deactivate-mark)
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
437 (copy-region-as-kill (mark) (point)))
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
438 (mouse-set-region-1)))
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
439
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
440 (defun mouse-set-region-1 ()
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
441 (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
442 (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
443 (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
444
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
445 (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
446 "*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
447 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
448 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
449 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
450 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
451 This variable's value may be non-integral.
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
452 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
453 :type 'number
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
454 :group 'mouse)
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
455
17636
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
456 (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
457 "*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
458 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
459 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
460 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
461 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
462 of lines specified by this variable."
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
463 :type 'integer
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
464 :group 'mouse)
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
465
7932
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
466 (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
467 "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
468 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
469 the newly visible text.
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
470 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
471 (cond
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
472 ((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
473 (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
474 ((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
475 (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
476 (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
477 (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
478 (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
479 (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
480 (progn
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
481 (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
482 (if (natnump jump)
21176
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
483 (if (window-end window)
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
484 (progn
c42a2b3bbb21 (mouse-scroll-subr): Handle if window-end returns nil.
Richard M. Stallman <rms@gnu.org>
parents: 21148
diff changeset
485 (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
486 ;; 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
487 ;; 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
488 (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
489 (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
490 (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
491 (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
492 (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
493 ;; 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
494 ;; 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
495 ;; 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
496 (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
497 (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
498 (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
499 (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
500 (goto-char opoint))))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
501
11453
5ed0795c4155 Create mouse-drag-overlay as a dead overlay, instead
Karl Heuer <kwzh@gnu.org>
parents: 11235
diff changeset
502 ;; Create an overlay and immediately delete it, to get "overlay in no buffer".
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
503 (defvar mouse-drag-overlay (make-overlay 1 1))
11453
5ed0795c4155 Create mouse-drag-overlay as a dead overlay, instead
Karl Heuer <kwzh@gnu.org>
parents: 11235
diff changeset
504 (delete-overlay mouse-drag-overlay)
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
505 (overlay-put mouse-drag-overlay 'face 'region)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
506
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
507 (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
508
12436
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
509 (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
510
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
511 (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
512 "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
513 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
514 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
515 In Transient Mark mode, the highlighting remains as long as the mark
a152ab5c09b0 (mouse-drag-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 15082
diff changeset
516 remains active. Otherwise, it remains until the next input event."
3566
dc2b64ef30dc (mouse-drag-region-1): Un-comment-out this function.
Richard M. Stallman <rms@gnu.org>
parents: 3420
diff changeset
517 (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
518 (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
519 (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
520 (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
521 (start-point (posn-point start-posn))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
522 (start-window (posn-window start-posn))
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
523 (start-frame (window-frame start-window))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
524 (bounds (window-edges start-window))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
525 (top (nth 1 bounds))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
526 (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
527 (nth 3 bounds)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
528 ;; 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
529 (1- (nth 3 bounds))))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
530 (click-count (1- (event-click-count start-event))))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
531 (setq mouse-selection-click-count click-count)
12436
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
532 (setq mouse-selection-click-count-buffer (current-buffer))
4490
8362b57424dc (mouse-set-point): Error if click in inactive minibuffer.
Richard M. Stallman <rms@gnu.org>
parents: 4472
diff changeset
533 (mouse-set-point start-event)
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
534 ;; 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
535 ;; 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
536 (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
537 (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
538 (setq start-point (point))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
539 (let ((range (mouse-start-end start-point start-point click-count)))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
540 (move-overlay mouse-drag-overlay (car range) (nth 1 range)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
541 (window-buffer start-window)))
4200
3f5f55401364 (mouse-drag-region): Use deactivate-mark.
Richard M. Stallman <rms@gnu.org>
parents: 4081
diff changeset
542 (deactivate-mark)
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
543 ;; end-of-range is used only in the single-click case.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
544 ;; It is the place where the drag has reached so far
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
545 ;; (but not outside the window where the drag started).
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
546 (let (event end end-point last-end-point (end-of-range (point)))
3566
dc2b64ef30dc (mouse-drag-region-1): Un-comment-out this function.
Richard M. Stallman <rms@gnu.org>
parents: 3420
diff changeset
547 (track-mouse
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
548 (while (progn
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
549 (setq event (read-event))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
550 (or (mouse-movement-p event)
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
551 (eq (car-safe event) 'switch-frame)))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
552 (if (eq (car-safe event) 'switch-frame)
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
553 nil
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
554 (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
555 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
556 (if (numberp end-point)
15642
6a3622bb0f31 (mouse-drag-region): Cope if stop-point is nil.
Karl Heuer <kwzh@gnu.org>
parents: 15633
diff changeset
557 (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
558
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
559 (cond
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
560 ;; 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
561 ((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
562 (integer-or-marker-p end-point))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
563 ;; Go to START-POINT first, so that when we move to END-POINT,
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
564 ;; if it's in the middle of intangible text,
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
565 ;; point jumps in the direction away from START-POINT.
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
566 (goto-char start-point)
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
567 (goto-char end-point)
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
568 (if (zerop (% click-count 3))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
569 (setq end-of-range (point)))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
570 (let ((range (mouse-start-end start-point (point) click-count)))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
571 (move-overlay mouse-drag-overlay (car range) (nth 1 range))))
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
572
6923
5df81bebf7f7 (mouse-drag-region): Handle scroll off top/bottom.
Karl Heuer <kwzh@gnu.org>
parents: 6914
diff changeset
573 (t
5df81bebf7f7 (mouse-drag-region): Handle scroll off top/bottom.
Karl Heuer <kwzh@gnu.org>
parents: 6914
diff changeset
574 (let ((mouse-row (cdr (cdr (mouse-position)))))
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
575 (cond
6923
5df81bebf7f7 (mouse-drag-region): Handle scroll off top/bottom.
Karl Heuer <kwzh@gnu.org>
parents: 6914
diff changeset
576 ((null mouse-row))
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
577 ((< mouse-row top)
7932
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
578 (mouse-scroll-subr start-window (- mouse-row top)
13307
4bc9015f709e (mouse-drag-region): Set end-of-range after calling mouse-scroll-subr.
Richard M. Stallman <rms@gnu.org>
parents: 13068
diff changeset
579 mouse-drag-overlay start-point)
4bc9015f709e (mouse-drag-region): Set end-of-range after calling mouse-scroll-subr.
Richard M. Stallman <rms@gnu.org>
parents: 13068
diff changeset
580 ;; Without this, point tends to jump back to the starting
4bc9015f709e (mouse-drag-region): Set end-of-range after calling mouse-scroll-subr.
Richard M. Stallman <rms@gnu.org>
parents: 13068
diff changeset
581 ;; position where the mouse button was pressed down.
4bc9015f709e (mouse-drag-region): Set end-of-range after calling mouse-scroll-subr.
Richard M. Stallman <rms@gnu.org>
parents: 13068
diff changeset
582 (setq end-of-range (overlay-start mouse-drag-overlay)))
8064
d04a39ce4f1d (mouse-scroll-subr): Don't do anything special at eob.
Richard M. Stallman <rms@gnu.org>
parents: 7966
diff changeset
583 ((>= mouse-row bottom)
7932
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
584 (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
13307
4bc9015f709e (mouse-drag-region): Set end-of-range after calling mouse-scroll-subr.
Richard M. Stallman <rms@gnu.org>
parents: 13068
diff changeset
585 mouse-drag-overlay start-point)
4bc9015f709e (mouse-drag-region): Set end-of-range after calling mouse-scroll-subr.
Richard M. Stallman <rms@gnu.org>
parents: 13068
diff changeset
586 (setq end-of-range (overlay-end mouse-drag-overlay))))))))))
7966
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
587 (if (consp event)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
588 (let ((fun (key-binding (vector (car event)))))
10554
f5f5c52de2e4 (mouse-drag-region): Modify previous change--don't run the ordinary binding
Richard M. Stallman <rms@gnu.org>
parents: 10553
diff changeset
589 ;; Run the binding of the terminating up-event, if possible.
f5f5c52de2e4 (mouse-drag-region): Modify previous change--don't run the ordinary binding
Richard M. Stallman <rms@gnu.org>
parents: 10553
diff changeset
590 ;; In the case of a multiple click, it gives the wrong results,
f5f5c52de2e4 (mouse-drag-region): Modify previous change--don't run the ordinary binding
Richard M. Stallman <rms@gnu.org>
parents: 10553
diff changeset
591 ;; because it would fail to set up a region.
18459
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
592 (if (not (= (overlay-start mouse-drag-overlay)
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
593 (overlay-end mouse-drag-overlay)))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
594 (let* ((stop-point
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
595 (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
596 (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
597 last-end-point))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
598 ;; 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
599 ;; Point goes here.
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
600 (region-termination
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
601 (if (and stop-point (< stop-point start-point))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
602 (overlay-start mouse-drag-overlay)
10369
1b6d44607114 (mouse-drag-region): As once in the past,
Richard M. Stallman <rms@gnu.org>
parents: 10258
diff changeset
603 (overlay-end mouse-drag-overlay)))
18459
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
604 ;; The end that comes from where we started the drag.
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
605 ;; Mark goes there.
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
606 (region-commencement
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
607 (- (+ (overlay-end mouse-drag-overlay)
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
608 (overlay-start mouse-drag-overlay))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
609 region-termination))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
610 last-command this-command)
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
611 (push-mark region-commencement t t)
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
612 (goto-char region-termination)
21194
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
613 ;; Don't let copy-region-as-kill set deactivate-mark.
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
614 (let (deactivate-mark)
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
615 (copy-region-as-kill (point) (mark t)))
18459
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
616 (let ((buffer (current-buffer)))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
617 (mouse-show-mark)
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
618 ;; mouse-show-mark can call read-event,
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
619 ;; and that means the Emacs server could switch buffers
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
620 ;; under us. If that happened,
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
621 ;; avoid trying to use the region.
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
622 (and (mark t) mark-active
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
623 (eq buffer (current-buffer))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
624 (mouse-set-region-1))))
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
625 (delete-overlay mouse-drag-overlay)
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
626 ;; Run the binding of the terminating up-event.
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
627 (if (fboundp fun)
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
628 (setq unread-command-events
688c725c6b23 (mouse-drag-region): For a click (not a drag),
Richard M. Stallman <rms@gnu.org>
parents: 17983
diff changeset
629 (cons event unread-command-events)))))
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
630 (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
631
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
632 ;; 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
633
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
634 (defun mouse-skip-word (dir)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
635 "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
636 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
637 (let* ((char (following-char))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
638 (syntax (char-to-string (char-syntax char))))
13038
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
639 (cond ((or (string= syntax "w") (string= syntax " "))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
640 (if (< dir 0)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
641 (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
642 (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
643 ((string= syntax "_")
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
644 (if (< dir 0)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
645 (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
646 (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
647 ((< dir 0)
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
648 (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
649 (forward-char -1)))
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
650 (t
d07703594662 (C-down-mouse-1): Use buffer menu, not font menu.
Richard M. Stallman <rms@gnu.org>
parents: 12844
diff changeset
651 (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
652 (forward-char 1))))))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
653
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
654 ;; Return a list of region bounds based on START and END according to MODE.
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
655 ;; If MODE is 0 then set point to (min START END), mark to (max START END).
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
656 ;; If MODE is 1 then set point to start of word at (min START END),
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
657 ;; mark to end of word at (max START END).
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
658 ;; If MODE is 2 then do the same for lines.
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
659 (defun mouse-start-end (start end mode)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
660 (if (> start end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
661 (let ((temp start))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
662 (setq start end
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
663 end temp)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
664 (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
665 (cond ((= mode 0)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
666 (list start end))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
667 ((and (= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
668 (= 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
669 (char-after start)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
670 (= (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
671 (list start
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
672 (save-excursion
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
673 (goto-char start)
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
674 (forward-sexp 1)
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
675 (point))))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
676 ((and (= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
677 (= 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
678 (char-after start)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
679 (= (char-syntax (char-after start)) ?\)))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
680 (list (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
681 (goto-char (1+ start))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
682 (backward-sexp 1)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
683 (point))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
684 (1+ start)))
15561
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
685 ((and (= mode 1)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
686 (= start end)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
687 (char-after start)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
688 (= (char-syntax (char-after start)) ?\"))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
689 (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
690 (save-excursion
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
691 (goto-char (- start 1))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
692 (looking-at "\\s(\\|\\s \\|\\s>")))))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
693 (if open
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
694 (list start
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
695 (save-excursion
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
696 (condition-case nil
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
697 (progn
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
698 (goto-char start)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
699 (forward-sexp 1)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
700 (point))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
701 (error end))))
16746
9d2a854bac89 (mouse-start-end): Put values in proper order,
Richard M. Stallman <rms@gnu.org>
parents: 16636
diff changeset
702 (list (save-excursion
15561
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
703 (condition-case nil
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
704 (progn
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
705 (goto-char (1+ start))
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
706 (backward-sexp 1)
6f50026fd1e6 (mouse-start-end): Support selecting strings by double
Richard M. Stallman <rms@gnu.org>
parents: 15476
diff changeset
707 (point))
16746
9d2a854bac89 (mouse-start-end): Put values in proper order,
Richard M. Stallman <rms@gnu.org>
parents: 16636
diff changeset
708 (error end)))
9d2a854bac89 (mouse-start-end): Put values in proper order,
Richard M. Stallman <rms@gnu.org>
parents: 16636
diff changeset
709 (1+ start)))))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
710 ((= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
711 (list (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
712 (goto-char start)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
713 (mouse-skip-word -1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
714 (point))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
715 (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
716 (goto-char end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
717 (mouse-skip-word 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
718 (point))))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
719 ((= mode 2)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
720 (list (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
721 (goto-char start)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
722 (beginning-of-line 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
723 (point))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
724 (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
725 (goto-char end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
726 (forward-line 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
727 (point))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
728
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
729 ;; Subroutine: set the mark where CLICK happened,
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
730 ;; but don't do anything else.
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
731 (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
732 (mouse-minibuffer-check click)
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
733 (let ((posn (event-start click)))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
734 (select-window (posn-window posn))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
735 (if (numberp (posn-point posn))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
736 (push-mark (posn-point posn) t t))))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
737
15613
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
738 (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
739 (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
740 (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
741 (event (car last))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
742 (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
743 (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
744 (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
745 (new
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
746 (if (consp event)
18503
828ca7cea30f (mouse-undouble-last-event): Use reverse, not nreverse.
Richard M. Stallman <rms@gnu.org>
parents: 18459
diff changeset
747 ;; 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
748 ;; 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
749 (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
750 (cdr event))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
751 event)))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
752 (setcar last new)
17983
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
753 (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
754 (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
755 t
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
756 (setcar last event)
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
757 nil)))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
758
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
759 ;; 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
760
f063cae001ee (mouse-region-delete-keys): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15880
diff changeset
761 (defvar mouse-region-delete-keys '([delete])
f063cae001ee (mouse-region-delete-keys): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15880
diff changeset
762 "List of keys which shall cause the mouse region to be deleted.")
f063cae001ee (mouse-region-delete-keys): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 15880
diff changeset
763
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
764 (defun mouse-show-mark ()
15613
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
765 (if transient-mark-mode
15321
1aeaf1224f0b (mouse-show-mark): Use temporary highlighting if possible instead of a pause.
Richard M. Stallman <rms@gnu.org>
parents: 15169
diff changeset
766 (if window-system
15613
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
767 (delete-overlay mouse-drag-overlay))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
768 (if window-system
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
769 (let ((inhibit-quit t)
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
770 (echo-keystrokes 0)
16016
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
771 event events key ignore
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
772 x-lost-selection-hooks)
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
773 (add-hook 'x-lost-selection-hooks
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
774 '(lambda (seltype)
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
775 (if (eq seltype 'PRIMARY)
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
776 (progn (setq ignore t)
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
777 (throw 'mouse-show-mark t)))))
15613
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
778 (move-overlay mouse-drag-overlay (point) (mark t))
16016
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
779 (catch 'mouse-show-mark
18675
a22ef14d16f8 (mouse-show-mark): Handle switch-frame events in the loop.
Richard M. Stallman <rms@gnu.org>
parents: 18503
diff changeset
780 ;; In this loop, execute scroll bar and switch-frame events.
a22ef14d16f8 (mouse-show-mark): Handle switch-frame events in the loop.
Richard M. Stallman <rms@gnu.org>
parents: 18503
diff changeset
781 ;; Also ignore down-events that are undefined.
16016
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
782 (while (progn (setq event (read-event))
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
783 (setq events (append events (list event)))
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
784 (setq key (apply 'vector events))
17983
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
785 (or (and (consp event)
18675
a22ef14d16f8 (mouse-show-mark): Handle switch-frame events in the loop.
Richard M. Stallman <rms@gnu.org>
parents: 18503
diff changeset
786 (eq (car event) 'switch-frame))
a22ef14d16f8 (mouse-show-mark): Handle switch-frame events in the loop.
Richard M. Stallman <rms@gnu.org>
parents: 18503
diff changeset
787 (and (consp event)
17983
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
788 (eq (posn-point (event-end event))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
789 'vertical-scroll-bar))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
790 (and (memq 'down (event-modifiers event))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
791 (not (key-binding key))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
792 (not (mouse-undouble-last-event events))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
793 (not (member key mouse-region-delete-keys)))))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
794 (and (consp event)
18675
a22ef14d16f8 (mouse-show-mark): Handle switch-frame events in the loop.
Richard M. Stallman <rms@gnu.org>
parents: 18503
diff changeset
795 (or (eq (car event) 'switch-frame)
a22ef14d16f8 (mouse-show-mark): Handle switch-frame events in the loop.
Richard M. Stallman <rms@gnu.org>
parents: 18503
diff changeset
796 (eq (posn-point (event-end event))
a22ef14d16f8 (mouse-show-mark): Handle switch-frame events in the loop.
Richard M. Stallman <rms@gnu.org>
parents: 18503
diff changeset
797 'vertical-scroll-bar))
17983
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
798 (let ((keys (vector 'vertical-scroll-bar event)))
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
799 (and (key-binding keys)
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
800 (progn
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
801 (call-interactively (key-binding keys)
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
802 nil keys)
56f88318699c (mouse-undouble-last-event): Return nil if the event
Richard M. Stallman <rms@gnu.org>
parents: 17636
diff changeset
803 (setq events nil)))))))
16016
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
804 ;; If we lost the selection, just turn off the highlighting.
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
805 (if ignore
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
806 nil
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
807 ;; For certain special keys, delete the region.
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
808 (if (member key mouse-region-delete-keys)
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
809 (delete-region (overlay-start mouse-drag-overlay)
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
810 (overlay-end mouse-drag-overlay))
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
811 ;; Otherwise, unread the key so it gets executed normally.
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
812 (setq unread-command-events
2ee7579db4a9 (mouse-show-mark): Detect loss of selection
Richard M. Stallman <rms@gnu.org>
parents: 15941
diff changeset
813 (nconc events unread-command-events))))
15613
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
814 (setq quit-flag nil)
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
815 (delete-overlay mouse-drag-overlay))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
816 (save-excursion
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
817 (goto-char (mark t))
4c646bed64d0 (mouse-show-mark): In transient mark mode, delete mouse-drag-overlay.
Miles Bader <miles@gnu.org>
parents: 15561
diff changeset
818 (sit-for 1)))))
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
819
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
820 (defun mouse-set-mark (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
821 "Set mark at the position clicked on with the mouse.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
822 Display cursor at that position for a second.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
823 This must be bound to a mouse click."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
824 (interactive "e")
8534
a446d13c46ea (mouse-set-mark): Select the window before saving point.
Richard M. Stallman <rms@gnu.org>
parents: 8519
diff changeset
825 (mouse-minibuffer-check click)
a446d13c46ea (mouse-set-mark): Select the window before saving point.
Richard M. Stallman <rms@gnu.org>
parents: 8519
diff changeset
826 (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
827 ;; 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
828 (let ((point-save (point)))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
829 (unwind-protect
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
830 (progn (mouse-set-point click)
3119
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
831 (push-mark nil t t)
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
832 (or transient-mark-mode
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
833 (sit-for 1)))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
834 (goto-char point-save))))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
835
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
836 (defun mouse-kill (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
837 "Kill the region between point and the mouse click.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
838 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
839 (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
840 (mouse-minibuffer-check click)
6301
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
841 (let* ((posn (event-start click))
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
842 (click-posn (posn-point posn)))
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
843 (select-window (posn-window posn))
1039
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
844 (if (numberp click-posn)
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
845 (kill-region (min (point) click-posn)
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
846 (max (point) click-posn)))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
847
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
848 (defun mouse-yank-at-click (click arg)
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
849 "Insert the last stretch of killed text at the position clicked on.
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
850 Also move point to one end of the text thus inserted (normally the end).
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
851 Prefix arguments are interpreted as with \\[yank].
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
852 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
853 regardless of where you click."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
854 (interactive "e\nP")
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
855 ;; 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
856 (run-hooks 'mouse-leave-buffer-hook)
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
857 (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
858 (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
859 (setq mouse-selection-click-count 0)
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
860 (yank arg))
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
861
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
862 (defun mouse-kill-ring-save (click)
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
863 "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
864 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
865 (interactive "e")
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
866 (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
867 (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
868 (kill-ring-save (point) (mark t)))
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
869 (mouse-show-mark))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
870
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
871 ;;; 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
872 ;;; 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
873 ;;; people found that confusing.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
874
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
875 ;;; 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
876 ;;; invocation of mouse-save-then-kill.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
877 (defvar mouse-save-then-kill-posn nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
878
5007
8ed435ca9650 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 4906
diff changeset
879 (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
880 ;; We must make our own undo boundaries
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
881 ;; 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
882 (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
883 (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
884 ;; 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
885 ;; just delete.
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
886 (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
887 ;; 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
888 ;; 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
889 ;; for the first time, the undo list records that fact.
7866
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
890 (let (before-change-function after-change-function
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
891 before-change-functions after-change-functions)
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
892 (delete-region beg
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
893 (+ 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
894 (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
895 ;; Undo that deletion--but don't change the undo list!
7866
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
896 (let (before-change-function after-change-function
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
897 before-change-functions after-change-functions)
44680acb5d14 (mouse-save-then-kill-delete-region): Turn off change hooks
Richard M. Stallman <rms@gnu.org>
parents: 7794
diff changeset
898 (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
899 ;; 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
900 ;; 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
901 (setq buffer-undo-list t)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
902 (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
903 (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
904 (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
905 (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
906 ;; 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
907 ;; 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
908 (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
909 (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
910 ;; 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
911 (and tail
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
912 (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
913 (undo-boundary))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
914
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
915 (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
916 "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
917 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
918 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
919 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
920 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
921
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
922 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
923 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
924 again in a different position, it extends the selection again.
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
925 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
926 (interactive "e")
21426
4b4a4e32ffef (mouse-save-then-kill): Get point-before-scroll
Richard M. Stallman <rms@gnu.org>
parents: 21194
diff changeset
927 (let ((before-scroll
4b4a4e32ffef (mouse-save-then-kill): Get point-before-scroll
Richard M. Stallman <rms@gnu.org>
parents: 21194
diff changeset
928 (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
929 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
930 (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
931 (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
932 ;; 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
933 ;; 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
934 (this-command this-command))
12436
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
935 (if (and (save-excursion
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
936 (set-buffer (window-buffer (posn-window (event-start click))))
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
937 (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
938 ;; Don't be fooled by a recent click in some other buffer.
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
939 (eq mouse-selection-click-count-buffer
ffd777dc7d29 (mouse-selection-click-count-buffer): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 12357
diff changeset
940 (current-buffer)))))
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
941 (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
942 (equal click-posn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
943 (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
944 ;; 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
945 (let* ((range
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
946 (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
947 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
948 ;; 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
949 ;; 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
950 (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
951 (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
952 (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
953 (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
954 ;; 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
955 ;; 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
956 ;; (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
957 (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
958 (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
959 ;; 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
960 (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
961 (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
962 (mouse-show-mark))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
963 ;; 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
964 ;; that time kill.
11818
f470809e6a60 (mouse-save-then-kill): When making a new region
Richard M. Stallman <rms@gnu.org>
parents: 11453
diff changeset
965 (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
966 (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
967 (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
968 (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
969 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
970 (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
971 (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
972 ;; 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
973 ;; 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
974 (progn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
975 (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
976 ;; 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
977 (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
978 ;; 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
979 ;; 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
980 (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
981 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
982 (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
983 (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
984 '(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
985 (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
986 (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
987 ;; 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
988 (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
989 (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
990 (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
991 (if (numberp new)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
992 (progn
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
993 ;; 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
994 ;; That is 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
995 (if (< (abs (- new (point))) (abs (- new (mark t))))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
996 (goto-char new)
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
997 (set-mark new))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
998 (setq deactivate-mark nil)))
11818
f470809e6a60 (mouse-save-then-kill): When making a new region
Richard M. Stallman <rms@gnu.org>
parents: 11453
diff changeset
999 (kill-new (buffer-substring (point) (mark t)) t)
f470809e6a60 (mouse-save-then-kill): When making a new region
Richard M. Stallman <rms@gnu.org>
parents: 11453
diff changeset
1000 (mouse-show-mark))
10556
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1001 ;; 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
1002 (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
1003 (if before-scroll
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1004 (goto-char before-scroll))
fda9e00240b0 (mouse-save-then-kill): When we don't use existing
Richard M. Stallman <rms@gnu.org>
parents: 10554
diff changeset
1005 (exchange-point-and-mark)
15321
1aeaf1224f0b (mouse-show-mark): Use temporary highlighting if possible instead of a pause.
Richard M. Stallman <rms@gnu.org>
parents: 15169
diff changeset
1006 (kill-new (buffer-substring (point) (mark t)))
1aeaf1224f0b (mouse-show-mark): Use temporary highlighting if possible instead of a pause.
Richard M. Stallman <rms@gnu.org>
parents: 15169
diff changeset
1007 (if window-system
1aeaf1224f0b (mouse-show-mark): Use temporary highlighting if possible instead of a pause.
Richard M. Stallman <rms@gnu.org>
parents: 15169
diff changeset
1008 (mouse-show-mark)))
10720
4526bdcc806e (mouse-drag-region): Delete the overlay before
Richard M. Stallman <rms@gnu.org>
parents: 10556
diff changeset
1009 (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
1010 (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
1011 (list (car kill-ring) (point) click-posn)))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1012
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1013 (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
1014 (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
1015 (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
1016 (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
1017 (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
1018
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1019 ;; An overlay which records the current secondary selection
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1020 ;; or else is deleted when there is no secondary selection.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1021 ;; May be nil.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1022 (defvar mouse-secondary-overlay nil)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1023
9206
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1024 (defvar mouse-secondary-click-count 0)
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1025
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1026 ;; 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
1027 ;; May be nil.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1028 (defvar mouse-secondary-start nil)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1029
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1030 (defun mouse-start-secondary (click)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1031 "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
1032 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
1033 and complete the secondary selection."
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1034 (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
1035 (mouse-minibuffer-check click)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1036 (let ((posn (event-start click)))
3823
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1037 (save-excursion
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1038 (set-buffer (window-buffer (posn-window posn)))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1039 ;; Cancel any preexisting secondary selection.
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1040 (if mouse-secondary-overlay
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1041 (delete-overlay mouse-secondary-overlay))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1042 (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
1043 (progn
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1044 (or mouse-secondary-start
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1045 (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
1046 (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
1047
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1048 (defun mouse-set-secondary (click)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1049 "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
1050 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
1051 (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
1052 (mouse-minibuffer-check click)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1053 (let ((posn (event-start click))
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1054 beg
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1055 (end (event-end click)))
3823
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1056 (save-excursion
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1057 (set-buffer (window-buffer (posn-window posn)))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1058 (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
1059 (setq beg (posn-point posn)))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1060 (if mouse-secondary-overlay
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1061 (move-overlay mouse-secondary-overlay beg (posn-point end))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1062 (setq mouse-secondary-overlay (make-overlay beg (posn-point end))))
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
1063 (overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1064
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1065 (defun mouse-drag-secondary (start-event)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1066 "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
1067 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
1068 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
1069 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
1070 (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
1071 (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
1072 (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
1073 (start-posn (event-start start-event))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1074 (start-point (posn-point start-posn))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1075 (start-window (posn-window start-posn))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1076 (start-frame (window-frame start-window))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1077 (bounds (window-edges start-window))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1078 (top (nth 1 bounds))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1079 (bottom (if (window-minibuffer-p start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1080 (nth 3 bounds)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1081 ;; Don't count the mode line.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1082 (1- (nth 3 bounds))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1083 (click-count (1- (event-click-count start-event))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1084 (save-excursion
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1085 (set-buffer (window-buffer start-window))
9206
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1086 (setq mouse-secondary-click-count click-count)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1087 (or mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1088 (setq mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1089 (make-overlay (point) (point))))
5007
8ed435ca9650 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 4906
diff changeset
1090 (overlay-put mouse-secondary-overlay 'face 'secondary-selection)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1091 (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
1092 ;; 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
1093 ;; of one word or line.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1094 (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
1095 (set-marker mouse-secondary-start nil)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1096 (move-overlay mouse-secondary-overlay 1 1
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1097 (window-buffer start-window))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1098 (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
1099 (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
1100 ;; 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
1101 (or mouse-secondary-start
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1102 (setq mouse-secondary-start (make-marker)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1103 (set-marker mouse-secondary-start start-point)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1104 (delete-overlay mouse-secondary-overlay))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1105 (let (event end end-point)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1106 (track-mouse
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1107 (while (progn
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1108 (setq event (read-event))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1109 (or (mouse-movement-p event)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1110 (eq (car-safe event) 'switch-frame)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1111
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1112 (if (eq (car-safe event) 'switch-frame)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1113 nil
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1114 (setq end (event-end event)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1115 end-point (posn-point end))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1116 (cond
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1117 ;; Are we moving within the original window?
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1118 ((and (eq (posn-window end) start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1119 (integer-or-marker-p end-point))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1120 (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
1121 click-count)))
8224
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1122 (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
1123 (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
1124 (progn
1cc48bdd0c6b (mouse-drag-secondary): Don't start making an overlay
Richard M. Stallman <rms@gnu.org>
parents: 8204
diff changeset
1125 (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
1126 (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
1127 (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
1128 (t
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1129 (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
1130 (cond
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1131 ((null mouse-row))
4a0b3a63e51e (mouse-drag-secondary): Handle mouse motion out of window
Richard M. Stallman <rms@gnu.org>
parents: 7363
diff changeset
1132 ((< mouse-row top)
7932
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
1133 (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
1134 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
1135 ((>= mouse-row bottom)
7932
ac4b606bcfa2 (mouse-scroll-subr): New arg WINDOW.
Richard M. Stallman <rms@gnu.org>
parents: 7901
diff changeset
1136 (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
1137 mouse-secondary-overlay start-point)))))))))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1138
7966
76118755a179 (mouse-scroll-subr): Preserve point if WINDOW's not the selected window.
Richard M. Stallman <rms@gnu.org>
parents: 7932
diff changeset
1139 (if (consp event)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1140 (if (marker-position mouse-secondary-start)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1141 (save-window-excursion
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1142 (delete-overlay mouse-secondary-overlay)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1143 (x-set-selection 'SECONDARY nil)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1144 (select-window start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1145 (save-excursion
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1146 (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
1147 (sit-for 1)
86f1da650461 (mouse-drag-secondary): Make sure to return nil
Richard M. Stallman <rms@gnu.org>
parents: 16304
diff changeset
1148 nil))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1149 (x-set-selection
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1150 'SECONDARY
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1151 (buffer-substring (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1152 (overlay-end mouse-secondary-overlay)))))))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1154 (defun mouse-yank-secondary (click)
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1155 "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
1156 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
1157 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
1158 regardless of where you click."
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1159 (interactive "e")
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
1160 ;; 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
1161 (run-hooks 'mouse-leave-buffer-hook)
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
1162 (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
1163 (insert (x-get-selection 'SECONDARY)))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1164
5280
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1165 (defun mouse-kill-secondary ()
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1166 "Kill the text in the secondary selection.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1167 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
1168 but it can work as either one.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1169
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1170 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
1171 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
1172 is to prevent accidents."
5280
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1173 (interactive)
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1174 (let* ((keys (this-command-keys))
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1175 (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
1176 (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
1177 (if (listp click)
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1178 (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
1179 (current-buffer)))
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1180 (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
1181 (let (this-command)
6c0dc7a8a07a (mouse-kill-secondary): Avoid changing this-command.
Richard M. Stallman <rms@gnu.org>
parents: 10790
diff changeset
1182 (save-excursion
6c0dc7a8a07a (mouse-kill-secondary): Avoid changing this-command.
Richard M. Stallman <rms@gnu.org>
parents: 10790
diff changeset
1183 (set-buffer (overlay-buffer mouse-secondary-overlay))
6c0dc7a8a07a (mouse-kill-secondary): Avoid changing this-command.
Richard M. Stallman <rms@gnu.org>
parents: 10790
diff changeset
1184 (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
1185 (overlay-end mouse-secondary-overlay))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1186 (delete-overlay mouse-secondary-overlay)
10838
6c0dc7a8a07a (mouse-kill-secondary): Avoid changing this-command.
Richard M. Stallman <rms@gnu.org>
parents: 10790
diff changeset
1187 ;;; (x-set-selection 'SECONDARY nil)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1188 (setq mouse-secondary-overlay nil))
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1189
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1190 (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
1191 "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
1192 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
1193 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
1194 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
1195 this command deletes the text.
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1196 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
1197 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
1198
7302
1d9c6f42c7ae (mouse-secondary-save-then-kill): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
1199 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
1200 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
1201 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
1202 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
1203 (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
1204 (mouse-minibuffer-check click)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1205 (let ((posn (event-start click))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1206 (click-posn (posn-point (event-start click)))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1207 ;; 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
1208 ;; prevent setting this-command to kill-region.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1209 (this-command this-command))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1210 (or (eq (window-buffer (posn-window posn))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1211 (or (and mouse-secondary-overlay
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1212 (overlay-buffer mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1213 (if mouse-secondary-start
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1214 (marker-buffer mouse-secondary-start))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1215 (error "Wrong buffer"))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1216 (save-excursion
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1217 (set-buffer (window-buffer (posn-window posn)))
9206
06864fef4ec3 (mouse-secondary-click-count): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 8765
diff changeset
1218 (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
1219 (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
1220 (equal click-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1221 (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
1222 ;; 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
1223 (let* ((range
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1224 (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
1225 mouse-secondary-click-count)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1226 ;; 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
1227 ;; 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
1228 (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
1229 (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
1230 (move-overlay mouse-secondary-overlay (car range)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1231 (overlay-end mouse-secondary-overlay))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1232 (move-overlay mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1233 (overlay-start mouse-secondary-overlay)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1234 (nth 1 range)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1235 ;; 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
1236 ;; Replace it with the extended region.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1237 ;; (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
1238 (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
1239 (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
1240 (overlay-end mouse-secondary-overlay)) t)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1241 ;; 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
1242 (setq mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1243 (list (car kill-ring) (point) click-posn)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1244 ;; 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
1245 ;; that time kill.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1246 (progn
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1247 (mouse-save-then-kill-delete-region
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1248 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1249 (overlay-end mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1250 (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
1251 (setq mouse-secondary-click-count 0)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1252 (delete-overlay mouse-secondary-overlay)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1253 (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
1254 mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1255 (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
1256 (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
1257 ;; 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
1258 ;; 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
1259 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1260 (mouse-save-then-kill-delete-region
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1261 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1262 (overlay-end mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1263 (setq mouse-save-then-kill-posn nil)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1264 (delete-overlay mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1265 (if (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1266 ;; We have a selection, so adjust it.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1267 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1268 (if (numberp click-posn)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1269 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1270 ;; 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
1271 ;; 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
1272 (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
1273 (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
1274 (move-overlay mouse-secondary-overlay click-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1275 (overlay-end mouse-secondary-overlay))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1276 (move-overlay mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1277 (overlay-start mouse-secondary-overlay)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1278 click-posn))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1279 (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
1280 (if (eq last-command 'mouse-secondary-save-then-kill)
8765
77933f36ddc2 (mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
parents: 8534
diff changeset
1281 ;; If the front of the kill ring comes from
77933f36ddc2 (mouse-save-then-kill, mouse-secondary-save-then-kill): Use the kill-new
Karl Heuer <kwzh@gnu.org>
parents: 8534
diff changeset
1282 ;; 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
1283 ;; 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
1284 ;; (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
1285 (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
1286 (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
1287 (overlay-end mouse-secondary-overlay)) t)
21194
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
1288 (let (deactivate-mark)
7a7950ffa79b (mouse-drag-region): Bind deactivate-mark
Richard M. Stallman <rms@gnu.org>
parents: 21176
diff changeset
1289 (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
1290 (overlay-end mouse-secondary-overlay)))))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1291 (if mouse-secondary-start
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1292 ;; 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
1293 ;; so put the other end here.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1294 (let ((start (+ 0 mouse-secondary-start)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1295 (kill-ring-save start click-posn)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1296 (if mouse-secondary-overlay
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1297 (move-overlay mouse-secondary-overlay start click-posn)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1298 (setq mouse-secondary-overlay (make-overlay start click-posn)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1299 (overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1300 (setq mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1301 (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
1302 (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
1303 (x-set-selection 'SECONDARY
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1304 (buffer-substring
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1305 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
1306 (overlay-end mouse-secondary-overlay)))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
1307
21148
bbbd345f54de (mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
parents: 20686
diff changeset
1308 (defcustom mouse-buffer-menu-maxlen 20
13872
e79f2b570509 (mouse-menu-buffer-maxlen): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13870
diff changeset
1309 "*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
1310 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
1311 `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
1312 :type 'integer
6a187f72db92 Use defcustom.
Richard M. Stallman <rms@gnu.org>
parents: 17008
diff changeset
1313 :group 'mouse)
13872
e79f2b570509 (mouse-menu-buffer-maxlen): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13870
diff changeset
1314
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1315 (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
1316 "*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
1317 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
1318 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
1319 `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
1320 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
1321 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
1322 :type 'integer
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1323 :group 'mouse
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1324 :version "20.3")
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1325
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
1326 (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
1327 '(("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
1328 ("\\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
1329 . "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
1330 ("\\<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
1331 ("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
1332 ("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
1333 ("Outline" . "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
1334 ("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
1335 "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
1336 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
1337 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
1338
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
1339 (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
1340 "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
1341 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
1342 and selects that window."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
1343 (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
1344 (mouse-minibuffer-check event)
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1345 (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
1346 ;; 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
1347 (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
1348 (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
1349 ;; 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
1350 ;; 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
1351 (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
1352 (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
1353 (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
1354 (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
1355 (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
1356 (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
1357 (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
1358 (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
1359 (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
1360 (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
1361 (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
1362 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
1363 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
1364 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
1365 (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
1366 (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
1367 (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
1368 ;; 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
1369 (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
1370 (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
1371 (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
1372 (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
1373 (+ sum-of-squares
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1374 (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
1375 (setq tail (cdr tail))))
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1376 (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
1377 (* (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
1378 ;; 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
1379 (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
1380 ;; 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
1381 (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
1382 (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
1383 (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
1384 (> (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
1385 ;; 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
1386 ;; 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
1387 ;; 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
1388 (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
1389 (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
1390 (> (* buffers-left 10) (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
1391 (setq subdivided-menus
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
1392 (cons (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
1393 (nth 1 (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
1394 (mouse-buffer-menu-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
1395 (cdr (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
1396 subdivided-menus))
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
1397 (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
1398 (- 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
1399 (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
1400 ;; 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
1401 ;; 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
1402 (if 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
1403 (setq subdivided-menus
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
1404 (cons (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
1405 "Others"
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
1406 (mouse-buffer-menu-alist
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1407 ;; we don't need split-by-major-mode any
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1408 ;; more, so we can ditch it with nconc.
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1409 (apply 'nconc (mapcar 'cddr split-by-major-mode))))
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
1410 subdivided-menus)))
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1411 (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
1412 (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
1413 (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
1414 (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
1415 (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
1416 (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
1417 (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
1418 (when buf
3420
08adfe96ca93 (mouse-buffer-menu): Don't select the event's window,
Richard M. Stallman <rms@gnu.org>
parents: 3231
diff changeset
1419 (or (framep window) (select-window window))
21685
b0ae6e29c252 (mouse-buffer-menu-mode-mult): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 21426
diff changeset
1420 (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
1421
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
1422 (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
1423 (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
1424 (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
1425 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
1426 (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
1427 (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
1428 (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
1429 (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
1430 (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
1431 (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
1432 (or (eq ?\ (aref (buffer-name (car tail)) 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
1433 (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
1434 (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
1435 (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
1436 (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
1437 (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
1438 (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
1439 (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
1440 (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
1441 (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
1442 (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
1443 (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
1444 (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
1445 (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
1446 (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
1447 (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
1448 (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
1449 (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
1450 (if buffer-read-only "%" " "))
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
1451 (or (buffer-file-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
1452 (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
1453 (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
1454 (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
1455 (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
1456 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
1457 ""))
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
1458 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
1459 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
1460 (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
1461 ;; 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
1462 (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
1463
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
1464 (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
1465 ;; 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
1466 ;; 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
1467 (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
1468 (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
1469 (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
1470 (while alist
21148
bbbd345f54de (mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
parents: 20686
diff changeset
1471 ;; 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
1472 ;; 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
1473 (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
1474 (if next
21148
bbbd345f54de (mouse-buffer-menu-maxlen): Renamed from mouse-menu-buffer-maxlen.
Richard M. Stallman <rms@gnu.org>
parents: 20686
diff changeset
1475 (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
1476 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
1477 (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
1478 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
1479 (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
1480 (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
1481 (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
1482 ;; 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
1483 (list (cons title alist))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1484
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1485 ;;; These need to be rewritten for the new scroll bar implementation.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1486
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1487 ;;;!! ;; Commands for the scroll bar.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1488 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1489 ;;;!! (defun mouse-scroll-down (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1490 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1491 ;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1492 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1493 ;;;!! (defun mouse-scroll-up (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1494 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1495 ;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1496 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1497 ;;;!! (defun mouse-scroll-down-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1498 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1499 ;;;!! (scroll-down nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1500 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1501 ;;;!! (defun mouse-scroll-up-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1502 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1503 ;;;!! (scroll-up nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1504 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1505 ;;;!! (defun mouse-scroll-move-cursor (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1506 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1507 ;;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1508 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1509 ;;;!! (defun mouse-scroll-absolute (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1510 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1511 ;;;!! (let* ((pos (car event))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1512 ;;;!! (position (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1513 ;;;!! (length (car (cdr pos))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1514 ;;;!! (if (<= length 0) (setq length 1))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1515 ;;;!! (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
1516 ;;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1517 ;;;!! position)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1518 ;;;!! length)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1519 ;;;!! scale-factor)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1520 ;;;!! (goto-char newpos)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1521 ;;;!! (recenter '(4)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1522 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1523 ;;;!! (defun mouse-scroll-left (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1524 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1525 ;;;!! (scroll-left (1+ (car (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1526 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1527 ;;;!! (defun mouse-scroll-right (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1528 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1529 ;;;!! (scroll-right (1+ (car (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1530 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1531 ;;;!! (defun mouse-scroll-left-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1532 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1533 ;;;!! (scroll-left nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1534 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1535 ;;;!! (defun mouse-scroll-right-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1536 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1537 ;;;!! (scroll-right nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1538 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1539 ;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1540 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1541 ;;;!! (move-to-column (1+ (car (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1542 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1543 ;;;!! (defun mouse-scroll-absolute-horizontally (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1544 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1545 ;;;!! (let* ((pos (car event))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1546 ;;;!! (position (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1547 ;;;!! (length (car (cdr pos))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1548 ;;;!! (set-window-hscroll (selected-window) 33)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1549 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1550 ;;;!! (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
1551 ;;;!! (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
1552 ;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1553 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1554 ;;;!! (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
1555 ;;;!! (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
1556 ;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1557 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1558 ;;;!! (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
1559 ;;;!! (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
1560 ;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1561 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1562 ;;;!! (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
1563 ;;;!! (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
1564 ;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1565 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1566 ;;;!! (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
1567 ;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1568 ;;;!! 'mouse-scroll-absolute-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1569 ;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1570 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1571 ;;;!! (global-set-key [horizontal-slider mouse-1]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1572 ;;;!! 'mouse-scroll-move-cursor-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1573 ;;;!! (global-set-key [horizontal-slider mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1574 ;;;!! 'mouse-scroll-move-cursor-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1575 ;;;!! (global-set-key [horizontal-slider mouse-3]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1576 ;;;!! 'mouse-scroll-move-cursor-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1577 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1578 ;;;!! (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
1579 ;;;!! (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
1580 ;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1581 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1582 ;;;!! (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
1583 ;;;!! (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
1584 ;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1585 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1586 ;;;!! (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
1587 ;;;!! 'mouse-split-window-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1588 ;;;!! (global-set-key [mode-line S-mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1589 ;;;!! 'mouse-split-window-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1590 ;;;!! (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
1591 ;;;!! 'mouse-split-window)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1592
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1593 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1594 ;;;!! ;;;; Here are experimental things being tested. Mouse events
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1595 ;;;!! ;;;; are of the form:
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1596 ;;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1597 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1598 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1599 ;;;!! ;;;; Dynamically track mouse coordinates
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1600 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1601 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1602 ;;;!! ;;(defun track-mouse (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1603 ;;;!! ;; "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
1604 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1605 ;;;!! ;; (while mouse-grabbed
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1606 ;;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1607 ;;;!! ;; (abs-x (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1608 ;;;!! ;; (abs-y (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1609 ;;;!! ;; (relative-coordinate (coordinates-in-window-p
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1610 ;;;!! ;; (list (car pos) (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1611 ;;;!! ;; (selected-window))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1612 ;;;!! ;; (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1613 ;;;!! ;; (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
1614 ;;;!! ;; (car relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1615 ;;;!! ;; (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1616 ;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1617 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1618 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1619 ;;;!! ;; 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
1620 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1621 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1622 ;;;!! ;;(require 'backquote)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1623 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1624 ;;;!! ;;(defun mouse-select-buffer-line (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1625 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1626 ;;;!! ;; (let ((relative-coordinate
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1627 ;;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1628 ;;;!! ;; (abs-y (car (cdr (car event)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1629 ;;;!! ;; (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1630 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1631 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1632 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1633 ;;;!! ;; (x-draw-rectangle
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1634 ;;;!! ;; (selected-screen)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1635 ;;;!! ;; abs-y 0
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1636 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1637 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1638 ;;;!! ;; (end-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1639 ;;;!! ;; (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1640 ;;;!! ;; (beginning-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1641 ;;;!! ;; (- (region-end) (region-beginning))) 1))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1642 ;;;!! ;; (sit-for 1)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1643 ;;;!! ;; (x-erase-rectangle (selected-screen))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1644 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1645 ;;;!! ;;(defvar last-line-drawn nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1646 ;;;!! ;;(defvar begin-delim "[^ \t]")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1647 ;;;!! ;;(defvar end-delim "[^ \t]")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1648 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1649 ;;;!! ;;(defun mouse-boxing (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1650 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1651 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1652 ;;;!! ;; (let ((screen (selected-screen)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1653 ;;;!! ;; (while (= (x-mouse-events) 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1654 ;;;!! ;; (let* ((pos (read-mouse-position screen))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1655 ;;;!! ;; (abs-x (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1656 ;;;!! ;; (abs-y (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1657 ;;;!! ;; (relative-coordinate
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1658 ;;;!! ;; (coordinates-in-window-p (` ((, abs-x) (, abs-y)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1659 ;;;!! ;; (selected-window)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1660 ;;;!! ;; (begin-reg nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1661 ;;;!! ;; (end-reg nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1662 ;;;!! ;; (end-column nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1663 ;;;!! ;; (begin-column nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1664 ;;;!! ;; (if (and (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1665 ;;;!! ;; (or (not last-line-drawn)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1666 ;;;!! ;; (not (= last-line-drawn abs-y))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1667 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1668 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1669 ;;;!! ;; (if (= (following-char) 10)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1670 ;;;!! ;; ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1671 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1672 ;;;!! ;; (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
1673 ;;;!! ;; (setq begin-column (1- (current-column)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1674 ;;;!! ;; (end-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1675 ;;;!! ;; (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
1676 ;;;!! ;; (setq end-column (1+ (current-column)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1677 ;;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1678 ;;;!! ;; (x-draw-rectangle screen
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1679 ;;;!! ;; (setq last-line-drawn abs-y)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1680 ;;;!! ;; begin-column
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1681 ;;;!! ;; (- end-column begin-column) 1))))))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1682 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1683 ;;;!! ;;(defun mouse-erase-box ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1684 ;;;!! ;; (interactive)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1685 ;;;!! ;; (if last-line-drawn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1686 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1687 ;;;!! ;; (x-erase-rectangle (selected-screen))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1688 ;;;!! ;; (setq last-line-drawn nil))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1689 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1690 ;;;!! ;;; (defun test-x-rectangle ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1691 ;;;!! ;;; (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
1692 ;;;!! ;;; (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
1693 ;;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1694 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1695 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1696 ;;;!! ;; 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
1697 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1698 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1699 ;;;!! (defvar double-start nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1700 ;;;!! (defconst double-click-interval 300
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1701 ;;;!! "Max ticks between clicks")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1702 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1703 ;;;!! (defun double-down (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1704 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1705 ;;;!! (if double-start
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1706 ;;;!! (let ((interval (- (nth 4 event) double-start)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1707 ;;;!! (if (< interval double-click-interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1708 ;;;!! (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1709 ;;;!! (backward-up-list 1)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1710 ;;;!! ;; (message "Interval %d" interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1711 ;;;!! (sleep-for 1)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1712 ;;;!! (setq double-start nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1713 ;;;!! (setq double-start (nth 4 event))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1714 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1715 ;;;!! (defun double-up (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1716 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1717 ;;;!! (and double-start
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1718 ;;;!! (> (- (nth 4 event ) double-start) double-click-interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1719 ;;;!! (setq double-start nil)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1720 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1721 ;;;!! ;;; (defun x-test-doubleclick ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1722 ;;;!! ;;; (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
1723 ;;;!! ;;; (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
1724 ;;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1725 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1726 ;;;!! ;;
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1727 ;;;!! ;; 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
1728 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1729 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1730 ;;;!! (defvar scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1731 ;;;!! (defconst scroll-speed 1)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1732 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1733 ;;;!! (defun incr-scroll-down (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1734 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1735 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1736 ;;;!! (incremental-scroll scroll-speed))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1737 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1738 ;;;!! (defun incr-scroll-up (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1739 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1740 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1741 ;;;!! (incremental-scroll (- scroll-speed)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1742 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1743 ;;;!! (defun incremental-scroll (n)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1744 ;;;!! (while (= (x-mouse-events) 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1745 ;;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1746 ;;;!! (scroll-down n)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1747 ;;;!! (sit-for 300 t)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1748 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1749 ;;;!! (defun incr-scroll-stop (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1750 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1751 ;;;!! (message "Scrolled %d lines" scrolled-lines)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1752 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1753 ;;;!! (sleep-for 1))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1754 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1755 ;;;!! ;;; (defun x-testing-scroll ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1756 ;;;!! ;;; (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
1757 ;;;!! ;;; (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
1758 ;;;!! ;;; (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
1759 ;;;!! ;;; (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
1760 ;;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1761 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1762 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1763 ;;;!! ;; 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
1764 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1765 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1766 ;;;!! (defun mouse-kill-rectangle (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1767 ;;;!! "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
1768 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1769 ;;;!! (let ((point-save (point)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1770 ;;;!! (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1771 ;;;!! (mouse-set-point event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1772 ;;;!! (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1773 ;;;!! (if (> point-save (point))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1774 ;;;!! (kill-rectangle (point) point-save)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1775 ;;;!! (kill-rectangle point-save (point))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1776 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1777 ;;;!! (defun mouse-open-rectangle (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1778 ;;;!! "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
1779 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1780 ;;;!! (let ((point-save (point)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1781 ;;;!! (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1782 ;;;!! (mouse-set-point event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1783 ;;;!! (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1784 ;;;!! (if (> point-save (point))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1785 ;;;!! (open-rectangle (point) point-save)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1786 ;;;!! (open-rectangle point-save (point))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1787 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1788 ;;;!! ;; Must be a better way to do this.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1789 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1790 ;;;!! (defun mouse-multiple-insert (n char)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1791 ;;;!! (while (> n 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1792 ;;;!! (insert char)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1793 ;;;!! (setq n (1- n))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1794 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1795 ;;;!! ;; What this could do is not finalize until button was released.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1796 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1797 ;;;!! (defun mouse-move-text (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1798 ;;;!! "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
1799 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1800 ;;;!! (let* ((relative-coordinate
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1801 ;;;!! (coordinates-in-window-p (car event) (selected-window))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1802 ;;;!! (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1803 ;;;!! (cond ((> (current-column) (car relative-coordinate))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1804 ;;;!! (delete-char
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1805 ;;;!! (- (car relative-coordinate) (current-column))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1806 ;;;!! ((< (current-column) (car relative-coordinate))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1807 ;;;!! (mouse-multiple-insert
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1808 ;;;!! (- (car relative-coordinate) (current-column)) " "))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1809 ;;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1810
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1811 ;; Choose a completion with the mouse.
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1812
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1813 (defun mouse-choose-completion (event)
4371
fb0e37e7afae (mouse-choose-completion): Actually choose that alternative,
Richard M. Stallman <rms@gnu.org>
parents: 4294
diff changeset
1814 "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
1815 (interactive "e")
10258
0bcc67b3fe66 (mouse-minibuffer-check, mouse-drag-mode-line)
Richard M. Stallman <rms@gnu.org>
parents: 9936
diff changeset
1816 ;; 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
1817 (run-hooks 'mouse-leave-buffer-hook)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1818 (let ((buffer (window-buffer))
8477
f4aa7a288cb6 (mouse-choose-completion): Pass completion-base-size value
Richard M. Stallman <rms@gnu.org>
parents: 8460
diff changeset
1819 choice
f4aa7a288cb6 (mouse-choose-completion): Pass completion-base-size value
Richard M. Stallman <rms@gnu.org>
parents: 8460
diff changeset
1820 base-size)
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1821 (save-excursion
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1822 (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
1823 (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
1824 (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
1825 (setq base-size completion-base-size)
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1826 (save-excursion
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1827 (goto-char (posn-point (event-start event)))
7593
a837cfdcf7c0 (mouse-choose-completion):
Richard M. Stallman <rms@gnu.org>
parents: 7588
diff changeset
1828 (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
1829 (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
1830 (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
1831 (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
1832 (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
1833 (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
1834 (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
1835 (point-max)))
7593
a837cfdcf7c0 (mouse-choose-completion):
Richard M. Stallman <rms@gnu.org>
parents: 7588
diff changeset
1836 (setq choice (buffer-substring beg end)))))
6231
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
1837 (let ((owindow (selected-window)))
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
1838 (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
1839 (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
1840 (window-dedicated-p (selected-window)))
10ed4c75936b (mouse-choose-completion): If *Completion* is a special
Richard M. Stallman <rms@gnu.org>
parents: 7637
diff changeset
1841 ;; 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
1842 (iconify-frame (selected-frame))
10ed4c75936b (mouse-choose-completion): If *Completion* is a special
Richard M. Stallman <rms@gnu.org>
parents: 7637
diff changeset
1843 (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
1844 (bury-buffer)))
6231
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
1845 (select-window owindow))
8477
f4aa7a288cb6 (mouse-choose-completion): Pass completion-base-size value
Richard M. Stallman <rms@gnu.org>
parents: 8460
diff changeset
1846 (choose-completion-string choice buffer base-size)))
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1847
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1848 ;; Font selection.
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1849
4294
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1850 (defun font-menu-add-default ()
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1851 (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
1852 (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
1853 (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
1854 (if (assoc "Default" elt)
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1855 (delete (assoc "Default" elt) elt))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1856 (setcdr elt
4562
477fbf60722b (font-menu-add-default): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 4554
diff changeset
1857 (cons (list "Default"
4294
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1858 (cdr (assq 'font (frame-parameters (selected-frame)))))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1859 (cdr elt)))))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1860
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1861 (defvar x-fixed-font-alist
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1862 '("Font menu"
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1863 ("Misc"
8460
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1864 ;; 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
1865 ("fixed" "fixed")
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1866 ("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
1867 ("6x12"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1868 "-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
1869 ("6x13"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1870 "-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
1871 ("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
1872 ("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
1873 ("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
1874 ("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
1875 ("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
1876 ("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
1877 ("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
1878 ("")
8487
0a77d1dbae03 (x-fixed-font-alist): Add clean 5x8 and clean 6x8.
Richard M. Stallman <rms@gnu.org>
parents: 8477
diff changeset
1879 ("clean 5x8"
0a77d1dbae03 (x-fixed-font-alist): Add clean 5x8 and clean 6x8.
Richard M. Stallman <rms@gnu.org>
parents: 8477
diff changeset
1880 "-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
1881 ("clean 6x8"
0a77d1dbae03 (x-fixed-font-alist): Add clean 5x8 and clean 6x8.
Richard M. Stallman <rms@gnu.org>
parents: 8477
diff changeset
1882 "-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
1883 ("clean 8x8"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1884 "-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
1885 ("clean 8x10"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1886 "-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
1887 ("clean 8x14"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1888 "-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
1889 ("clean 8x16"
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1890 "-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
1891 ("")
8460
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1892 ("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
1893 ;;; 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
1894 ;;; ("fg-18" "fg-18")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1895 ;;; ("fg-25" "fg-25")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1896 ;;; ("lucidasanstypewriter-12" "lucidasanstypewriter-12")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1897 ;;; ("lucidasanstypewriter-bold-14" "lucidasanstypewriter-bold-14")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1898 ;;; ("lucidasanstypewriter-bold-24" "lucidasanstypewriter-bold-24")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1899 ;;; ("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
1900 ;;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1901 ("Courier"
8460
5fd799a9946e (x-fixed-font-alist): Regularize how fonts are specified.
Richard M. Stallman <rms@gnu.org>
parents: 8426
diff changeset
1902 ;; 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
1903 ("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
1904 ("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
1905 ("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
1906 ("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
1907 ("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
1908 ("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
1909 ("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
1910 ("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
1911 ("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
1912 ("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
1913 ("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
1914 ("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
1915 ("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
1916 ("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
1917 ("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
1918 ("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
1919 ("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
1920 ("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
1921 ("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
1922 ("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
1923 ("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
1924 ("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
1925 ("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
1926 ("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
1927 )
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1928 "X fonts suitable for use in Emacs.")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1929
6867
0f4c8109274a (x-fixed-font-alist): Give multiple names for try for certain fonts.
Richard M. Stallman <rms@gnu.org>
parents: 6548
diff changeset
1930 (defun mouse-set-font (&rest fonts)
17008
3a99b530ad9a (mouse-set-font): Handle fontset.
Karl Heuer <kwzh@gnu.org>
parents: 16989
diff changeset
1931 "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
1932 (interactive
17008
3a99b530ad9a (mouse-set-font): Handle fontset.
Karl Heuer <kwzh@gnu.org>
parents: 16989
diff changeset
1933 (x-popup-menu
3a99b530ad9a (mouse-set-font): Handle fontset.
Karl Heuer <kwzh@gnu.org>
parents: 16989
diff changeset
1934 last-nonmenu-event
3a99b530ad9a (mouse-set-font): Handle fontset.
Karl Heuer <kwzh@gnu.org>
parents: 16989
diff changeset
1935 ;; Append list of fontsets currently defined.
3a99b530ad9a (mouse-set-font): Handle fontset.
Karl Heuer <kwzh@gnu.org>
parents: 16989
diff changeset
1936 (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
1937 (if fonts
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
1938 (let (font)
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
1939 (while fonts
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
1940 (condition-case nil
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
1941 (progn
7021
da5dc735eb50 (mouse-set-font): Simply call set-default-font.
Richard M. Stallman <rms@gnu.org>
parents: 6923
diff changeset
1942 (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
1943 (setq font (car fonts))
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
1944 (setq fonts nil))
7021
da5dc735eb50 (mouse-set-font): Simply call set-default-font.
Richard M. Stallman <rms@gnu.org>
parents: 6923
diff changeset
1945 (error
da5dc735eb50 (mouse-set-font): Simply call set-default-font.
Richard M. Stallman <rms@gnu.org>
parents: 6923
diff changeset
1946 (setq fonts (cdr fonts)))))
6914
569c2c6d812f (mouse-set-font): Don't error if no selection.
Karl Heuer <kwzh@gnu.org>
parents: 6867
diff changeset
1947 (if (null font)
7021
da5dc735eb50 (mouse-set-font): Simply call set-default-font.
Richard M. Stallman <rms@gnu.org>
parents: 6923
diff changeset
1948 (error "Font not found")))))
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1949
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1950 ;;; Bindings for mouse commands.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1951
2799
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
1952 (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
1953 (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
1954 (global-set-key [drag-mouse-1] 'mouse-set-region)
1057
d9775f33488d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1056
diff changeset
1955
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1956 ;; 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
1957 (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
1958 (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
1959
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1960 (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
1961 (global-set-key [mouse-3] 'mouse-save-then-kill)
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
1962
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1963 ;; 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
1964 ;; 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
1965 (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
1966 (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
1967 (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
1968 ;; C-down-mouse-2 is bound in facemenu.el.
9488
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
1969 (global-set-key [C-down-mouse-3] 'mouse-major-mode-menu)
114fe3739aa3 (mouse-major-mode-menu): Use minor-mode-map-alist
Richard M. Stallman <rms@gnu.org>
parents: 9206
diff changeset
1970
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1971
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
1972 ;; Replaced with dragging mouse-1
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
1973 ;; (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
1974
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
1975 (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
1976 (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
1977 (global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
1978 (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
1979 (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
1980 (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
1981 (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
1982 (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
1983 (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
1984 (global-set-key [vertical-line mouse-1] 'mouse-select-window)
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
1985
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
1986 (provide 'mouse)
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
1987
659
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
1988 ;;; mouse.el ends here