annotate lisp/mouse.el @ 6751:e4299463079d

(main): Call syms_of_term.
author Karl Heuer <kwzh@gnu.org>
date Fri, 08 Apr 1994 06:58:23 +0000
parents 2b0355912ba6
children 0f4c8109274a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
659
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
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
2070
95996f2ad1c6 (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 1980
diff changeset
3 ;;; Copyright (C) 1993 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
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
8 ;;; This file is part of GNU Emacs.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
10 ;;; GNU Emacs is free software; you can redistribute it and/or modify
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
11 ;;; it under the terms of the GNU General Public License as published by
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
12 ;;; the Free Software Foundation; either version 2, or (at your option)
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
13 ;;; any later version.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
15 ;;; GNU Emacs is distributed in the hope that it will be useful,
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
18 ;;; GNU General Public License for more details.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
20 ;;; You should have received a copy of the GNU General Public License
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
21 ;;; along with GNU Emacs; see the file COPYING. If not, write to
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
22 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23
2308
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
24 ;;; Commentary:
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
25
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
26 ;; 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
27 ;; 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
28 ;; 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
29 ;;
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
30 ;; The code is rather X-dependent.
f287613dfc28 Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2232
diff changeset
31
2232
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2070
diff changeset
32 ;;; Code:
4f9d60f7de9d Add standard library headers.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2070
diff changeset
33
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
34 ;;; Utility functions.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
35
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
36 ;;; Indent track-mouse like progn.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
37 (put 'track-mouse 'lisp-indent-function 0)
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
39 (defvar mouse-yank-at-point nil
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
40 "*If non-nil, mouse yank commands yank at point instead of at click.")
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
41
6266
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
42 (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
43 (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
44 (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
45 (not (minibuffer-window-active-p w))
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
46 (error "Minibuffer window is not active"))))
66c0ed95c03f (mouse-minibuffer-check): New function to disallow mouse events in an inactive
Karl Heuer <kwzh@gnu.org>
parents: 6231
diff changeset
47
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
48 (defun mouse-delete-window (click)
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
49 "Delete the window you click on.
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
50 This must be bound to a mouse click."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
51 (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
52 (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
53 (delete-window (posn-window (event-start click))))
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
54
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
55 (defun mouse-select-window (click)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
56 "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
57 (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
58 (mouse-minibuffer-check click)
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
59 (let ((oframe (selected-frame))
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
60 (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
61 (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
62 (raise-frame frame)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
63 (select-frame frame)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
64 (or (eq frame oframe)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
65 (set-mouse-position (selected-frame) (1- (frame-width)) 0))
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
66 (unfocus-frame)))
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
67
1421
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
68 (defun mouse-tear-off-window (click)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
69 "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
70 (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
71 (mouse-minibuffer-check click)
1421
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
72 (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
73 (buf (window-buffer window))
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
74 (frame (new-frame)))
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
75 (select-frame frame)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
76 (switch-to-buffer buf)
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
77 (delete-window window)))
a8378792a31d * mouse.el (mouse-tear-off-window): New function.
Jim Blandy <jimb@redhat.com>
parents: 1420
diff changeset
78
1363
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
79 (defun mouse-delete-other-windows ()
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
80 "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
81 (interactive "@")
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 (delete-other-windows))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
84 (defun mouse-split-window-vertically (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
85 "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
86 The window is split at the line clicked on.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
87 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
88 (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
89 (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
90 (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
91 (select-window (posn-window start))
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
92 (let ((new-height (if (eq (posn-point start) 'vertical-scroll-bar)
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
93 (scroll-bar-scale (posn-col-row start)
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
94 (1- (window-height)))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
95 (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
96 (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
97 (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
98 (if (< last-line first-line)
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
99 (error "window too short to split")
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
100 (split-window-vertically
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
101 (min (max new-height first-line) last-line))))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
103 (defun mouse-split-window-horizontally (click)
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
104 "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
105 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
106 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
107 (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
108 (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
109 (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
110 (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
111 (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
112 (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
113 (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
114 (if (< last-col first-col)
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
115 (error "window too narrow to split")
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
116 (split-window-horizontally
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
117 (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
118
4554
cf541ed1fed8 (mouse-set-point): Use event-end, not event-start.
Richard M. Stallman <rms@gnu.org>
parents: 4532
diff changeset
119 (defun mouse-set-point (event)
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
120 "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
121 This should be bound to a mouse click event type."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
122 (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
123 (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
124 ;; 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
125 ;; 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
126 (let ((posn (event-end event)))
1363
f34d8e4d1d7b * mouse.el: Begin adapting this to the new event format.
Jim Blandy <jimb@redhat.com>
parents: 1214
diff changeset
127 (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
128 (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
129 (goto-char (posn-point posn)))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130
1420
4005f73e5712 (mouse-set-region): New command. Bind drag-mouse-1 to it.
Richard M. Stallman <rms@gnu.org>
parents: 1363
diff changeset
131 (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
132 "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
133 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
134 (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
135 (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
136 (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
137 (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
138 (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
139 (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
140 (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
141 ;; If mark is highlighted, no need to bounce the cursor.
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
142 (or (and transient-mark-mode
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
143 (eq (framep (selected-frame)) 'x))
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
144 (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
145 (push-mark)
2802
02c75b605550 (mouse-set-region): Call set-mark to activate mark.
Richard M. Stallman <rms@gnu.org>
parents: 2799
diff changeset
146 (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
147 (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
148 (goto-char (posn-point end)))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
149 ;; 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
150 ;; C-w will not double the text in the kill ring.
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
151 (let (this-command)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
152 (copy-region-as-kill (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
153
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
154 (defvar mouse-scroll-delay 0.25
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
155 "*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
156 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
157 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
158 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
159 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
160 This variable's value may be non-integral.
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
161 Setting this to zero causes Emacs to scroll as fast as it can.")
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
162
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
163 (defun mouse-scroll-subr (jump &optional overlay start)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
164 "Scroll the selected window JUMP lines at a time, until new input arrives.
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
165 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
166 the newly visible text.
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
167 Upon exit, point is at the far edge of the newly visible text."
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
168 (while (progn
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
169 (goto-char (window-start))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
170 (if (not (zerop (vertical-motion jump)))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
171 (progn
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
172 (set-window-start (selected-window) (point))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
173 (if (natnump jump)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
174 (progn
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
175 (goto-char (window-end (selected-window)))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
176 ;; window-end doesn't reflect the window's new
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
177 ;; start position until the next redisplay. Hurrah.
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
178 (vertical-motion (1- jump)))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
179 (goto-char (window-start (selected-window))))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
180 (if overlay
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
181 (move-overlay overlay start (point)))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
182 (if (not (eobp))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
183 (sit-for mouse-scroll-delay))))))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
184 (point))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
185
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
186 (defvar mouse-drag-overlay (make-overlay 1 1))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
187 (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
188
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
189 (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
190
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
191 (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
192 "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
193 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
194 This must be bound to a button-down mouse event.
c2afed091afb (mouse-drag-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 4490
diff changeset
195 In Transient Mark mode, the highlighting remains once you
c2afed091afb (mouse-drag-region): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 4490
diff changeset
196 release the mouse button. Otherwise, it does not."
3566
dc2b64ef30dc (mouse-drag-region-1): Un-comment-out this function.
Richard M. Stallman <rms@gnu.org>
parents: 3420
diff changeset
197 (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
198 (mouse-minibuffer-check start-event)
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
199 (let* ((start-posn (event-start start-event))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
200 (start-point (posn-point start-posn))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
201 (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
202 (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
203 (bounds (window-edges start-window))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
204 (top (nth 1 bounds))
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
205 (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
206 (nth 3 bounds)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
207 ;; 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
208 (1- (nth 3 bounds))))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
209 (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
210 (setq mouse-selection-click-count click-count)
4490
8362b57424dc (mouse-set-point): Error if click in inactive minibuffer.
Richard M. Stallman <rms@gnu.org>
parents: 4472
diff changeset
211 (mouse-set-point start-event)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
212 (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
213 (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
214 (window-buffer start-window)))
4200
3f5f55401364 (mouse-drag-region): Use deactivate-mark.
Richard M. Stallman <rms@gnu.org>
parents: 4081
diff changeset
215 (deactivate-mark)
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
216 (let (event end end-point)
3566
dc2b64ef30dc (mouse-drag-region-1): Un-comment-out this function.
Richard M. Stallman <rms@gnu.org>
parents: 3420
diff changeset
217 (track-mouse
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
218 (while (progn
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
219 (setq event (read-event))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
220 (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
221 (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
222 (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
223 nil
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
224 (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
225 end-point (posn-point end))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
226
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
227 (cond
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
228
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
229 ;; Ignore switch-frame events.
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
230 ((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
231
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
232 ;; 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
233 ((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
234 (integer-or-marker-p end-point))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
235 (goto-char end-point)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
236 (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
237 (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
238
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
239 ;; Are we moving on a different window on the same frame?
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
240 ((and (windowp (posn-window end))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
241 (eq (window-frame (posn-window end)) start-frame))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
242 (let ((mouse-row
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
243 (+ (nth 1 (window-edges (posn-window end)))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
244 (cdr (posn-col-row end)))))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
245 (cond
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
246 ((< mouse-row top)
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
247 (mouse-scroll-subr
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
248 (- mouse-row top) mouse-drag-overlay start-point))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
249 ((and (not (eobp))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
250 (>= mouse-row bottom))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
251 (mouse-scroll-subr (1+ (- mouse-row bottom))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
252 mouse-drag-overlay start-point)))))
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
253
4577
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
254 (t
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
255 (let ((mouse-y (cdr (cdr (mouse-position))))
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
256 (menu-bar-lines (or (cdr (assq 'menu-bar-lines
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
257 (frame-parameters)))
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
258 0)))
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
259
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
260 ;; Are we on the menu bar?
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
261 (and (integerp mouse-y) (< mouse-y menu-bar-lines)
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
262 (mouse-scroll-subr (- mouse-y menu-bar-lines)
c071de572565 (mouse-drag-region): Mouse in menu bar means scroll up.
Richard M. Stallman <rms@gnu.org>
parents: 4563
diff changeset
263 mouse-drag-overlay start-point))))))))
3961
e828d5f28ca2 * mouse.el (mouse-drag-region): Correctly handle drags which enter
Jim Blandy <jimb@redhat.com>
parents: 3928
diff changeset
264
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
265 (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
266 (eq (posn-window (event-end event)) start-window)
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
267 (numberp (posn-point (event-end event))))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
268 (let ((fun (key-binding (vector (car event)))))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
269 (if (memq fun '(mouse-set-region mouse-set-point))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
270 (if (not (= (overlay-start mouse-drag-overlay)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
271 (overlay-end mouse-drag-overlay)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
272 (let (this-command)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
273 (push-mark (overlay-start mouse-drag-overlay) t t)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
274 (goto-char (overlay-end mouse-drag-overlay))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
275 (copy-region-as-kill (point) (mark t)))
4906
e3f09fe7f08f (mouse-drag-region): Set this-command to mouse-set-point
Richard M. Stallman <rms@gnu.org>
parents: 4788
diff changeset
276 (goto-char (overlay-end mouse-drag-overlay))
e3f09fe7f08f (mouse-drag-region): Set this-command to mouse-set-point
Richard M. Stallman <rms@gnu.org>
parents: 4788
diff changeset
277 (setq this-command 'mouse-set-point))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
278 (if (fboundp fun)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
279 (funcall fun event)))))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
280 (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
281
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
282 ;; 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
283
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
284 (defun mouse-skip-word (dir)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
285 "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
286 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
287 (let* ((char (following-char))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
288 (syntax (char-to-string (char-syntax char))))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
289 (if (or (string= syntax "w") (string= syntax " "))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
290 (if (< dir 0)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
291 (skip-syntax-backward syntax)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
292 (skip-syntax-forward syntax))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
293 (if (< dir 0)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
294 (while (and (not (bobp)) (= (preceding-char) char))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
295 (forward-char -1))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
296 (while (and (not (eobp)) (= (following-char) char))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
297 (forward-char 1))))))
3928
c5f9d7f928a7 * mouse.el (mouse-drag-region-1): Commented out.
Jim Blandy <jimb@redhat.com>
parents: 3899
diff changeset
298
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
299 ;; 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
300 ;; 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
301 ;; 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
302 ;; 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
303 ;; 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
304 (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
305 (if (> start end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
306 (let ((temp start))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
307 (setq start end
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
308 end temp)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
309 (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
310 (cond ((= mode 0)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
311 (list start end))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
312 ((and (= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
313 (= 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
314 (char-after start)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
315 (= (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
316 (list start
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
317 (save-excursion
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
318 (goto-char start)
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
319 (forward-sexp 1)
66aadd6ba5e6 (mouse-start-end): For double click with START on openparen,
Richard M. Stallman <rms@gnu.org>
parents: 5869
diff changeset
320 (point))))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
321 ((and (= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
322 (= 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
323 (char-after start)
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
324 (= (char-syntax (char-after start)) ?\)))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
325 (list (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
326 (goto-char (1+ start))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
327 (backward-sexp 1)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
328 (point))
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
329 (1+ start)))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
330 ((= mode 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
331 (list (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
332 (goto-char start)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
333 (mouse-skip-word -1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
334 (point))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
335 (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
336 (goto-char end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
337 (mouse-skip-word 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
338 (point))))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
339 ((= mode 2)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
340 (list (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
341 (goto-char start)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
342 (beginning-of-line 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
343 (point))
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
344 (save-excursion
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
345 (goto-char end)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
346 (forward-line 1)
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
347 (point))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
348
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
349 ;; Subroutine: set the mark where CLICK happened,
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
350 ;; but don't do anything else.
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
351 (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
352 (mouse-minibuffer-check click)
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
353 (let ((posn (event-start click)))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
354 (select-window (posn-window posn))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
355 (if (numberp (posn-point posn))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
356 (push-mark (posn-point posn) t t))))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
357
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
358 ;; Momentarily show where the mark is, if highlighting doesn't show it.
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
359 (defun mouse-show-mark ()
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
360 (or transient-mark-mode
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
361 (save-excursion
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
362 (goto-char (mark t))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
363 (sit-for 1))))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
364
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
365 (defun mouse-set-mark (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
366 "Set mark at the position clicked on with the mouse.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
367 Display cursor at that position for a second.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
368 This must be bound to a mouse click."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
369 (interactive "e")
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370 (let ((point-save (point)))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371 (unwind-protect
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
372 (progn (mouse-set-point click)
3119
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
373 (push-mark nil t t)
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
374 (or transient-mark-mode
0d4886af9262 (mouse-set-mark): Activate the mark.
Richard M. Stallman <rms@gnu.org>
parents: 2802
diff changeset
375 (sit-for 1)))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 (goto-char point-save))))
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
378 (defun mouse-kill (click)
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
379 "Kill the region between point and the mouse click.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
380 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
381 (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
382 (mouse-minibuffer-check click)
6301
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
383 (let* ((posn (event-start click))
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
384 (click-posn (posn-point posn)))
80e3ee8d618d (mouse-kill): Select the clicked window first.
Karl Heuer <kwzh@gnu.org>
parents: 6266
diff changeset
385 (select-window (posn-window posn))
1039
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
386 (if (numberp click-posn)
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
387 (kill-region (min (point) click-posn)
8ab465f7a7ff *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 840
diff changeset
388 (max (point) click-posn)))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
390 (defun mouse-yank-at-click (click arg)
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
391 "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
392 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
393 Prefix arguments are interpreted as with \\[yank].
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
394 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
395 regardless of where you click."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
396 (interactive "e\nP")
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
397 (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
398 (setq this-command 'yank)
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
399 (yank arg))
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
400
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
401 (defun mouse-kill-ring-save (click)
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
402 "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
403 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
404 (interactive "e")
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
405 (mouse-set-mark-fast click)
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
406 (kill-ring-save (point) (mark t))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
407 (mouse-show-mark))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
409 ;;; 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
410 ;;; 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
411 ;;; people found that confusing.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
412
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
413 ;;; 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
414 ;;; invocation of mouse-save-then-kill.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
415 (defvar mouse-save-then-kill-posn nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
416
5007
8ed435ca9650 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 4906
diff changeset
417 (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
418 ;; We must make our own undo boundaries
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
419 ;; 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
420 (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
421 (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
422 ;; 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
423 ;; just delete.
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
424 (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
425 ;; 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
426 ;; 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
427 ;; for the first time, the undo list records that fact.
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
428 (delete-region beg
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
429 (+ beg (if (> end beg) 1 -1)))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
430 (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
431 ;; Undo that deletion--but don't change the undo list!
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
432 (primitive-undo 1 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
433 ;; 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
434 ;; 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
435 (setq buffer-undo-list t)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
436 (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
437 (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
438 (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
439 (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
440 ;; 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
441 ;; 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
442 (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
443 (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
444 ;; 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
445 (and tail
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
446 (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
447 (undo-boundary))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
448
1214
467833df795b (mouse-split-window-vertically): Use @.
Richard M. Stallman <rms@gnu.org>
parents: 1113
diff changeset
449 (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
450 "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
451 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
452 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
453 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
454 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
455
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
456 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
457 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
458 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
459 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
460 (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
461 (mouse-minibuffer-check click)
3712
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
462 (let ((click-posn (posn-point (event-start click)))
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
463 ;; Don't let a subsequent kill command append to this one:
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
464 ;; prevent setting this-command to kill-region.
9e0f49a8f967 (mouse-set-mark-fast): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3566
diff changeset
465 (this-command this-command))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
466 (if (> (mod mouse-selection-click-count 3) 0)
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
467 (if (not (and (eq last-command 'mouse-save-then-kill)
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
468 (equal click-posn
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
469 (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
470 ;; Find both ends of the object selected by this click.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
471 (let* ((range
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
472 (mouse-start-end click-posn click-posn
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
473 mouse-selection-click-count)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
474 ;; Move whichever end is closer to the click.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
475 ;; That's what xterm does, and it seems reasonable.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
476 (if (< (abs (- click-posn (mark t)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
477 (abs (- click-posn (point))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
478 (set-mark (car range))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
479 (goto-char (nth 1 range)))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
480 ;; We have already put the old region in the kill ring.
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
481 ;; Replace it with the extended region.
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
482 ;; (It would be annoying to make a separate entry.)
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
483 (setcar kill-ring (buffer-substring (point) (mark t)))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
484 (if interprogram-cut-function
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
485 (funcall interprogram-cut-function (car kill-ring)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
486 ;; Arrange for a repeated mouse-3 to kill this region.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
487 (setq mouse-save-then-kill-posn
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
488 (list (car kill-ring) (point) click-posn))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
489 (mouse-show-mark))
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
490 ;; If we click this button again without moving it,
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
491 ;; that time kill.
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
492 (mouse-save-then-kill-delete-region (point) (mark))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
493 (setq mouse-selection-click-count 0)
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
494 (setq mouse-save-then-kill-posn nil))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
495 (if (and (eq last-command 'mouse-save-then-kill)
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
496 mouse-save-then-kill-posn
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
497 (eq (car mouse-save-then-kill-posn) (car kill-ring))
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
498 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
499 ;; If this is the second time we've called
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
500 ;; mouse-save-then-kill, delete the text from the buffer.
5027
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
501 (progn
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
502 (mouse-save-then-kill-delete-region (point) (mark))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
503 ;; After we kill, another click counts as "the first time".
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
504 (setq mouse-save-then-kill-posn nil))
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
505 (if (or (and (eq last-command 'mouse-save-then-kill)
38980ea73075 (mouse-save-then-kill-delete-region): Take args BEG and END.
Richard M. Stallman <rms@gnu.org>
parents: 5007
diff changeset
506 mouse-save-then-kill-posn)
4906
e3f09fe7f08f (mouse-drag-region): Set this-command to mouse-set-point
Richard M. Stallman <rms@gnu.org>
parents: 4788
diff changeset
507 (and mark-active transient-mark-mode)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
508 (and (eq last-command 'mouse-drag-region)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
509 (or mark-even-if-inactive
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
510 (not transient-mark-mode))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
511 ;; We have a selection or suitable region, so adjust it.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
512 (let* ((posn (event-start click))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
513 (new (posn-point posn)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
514 (select-window (posn-window posn))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
515 (if (numberp new)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
516 (progn
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
517 ;; Move whichever end of the region is closer to the click.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
518 ;; That is what xterm does, and it seems reasonable.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
519 (if (< (abs (- new (point))) (abs (- new (mark t))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
520 (goto-char new)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
521 (set-mark new))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
522 (setq deactivate-mark nil)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
523 (setcar kill-ring (buffer-substring (point) (mark t)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
524 (if interprogram-cut-function
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
525 (funcall interprogram-cut-function (car kill-ring))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
526 ;; We just have point, so set mark here.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
527 (mouse-set-mark-fast click)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
528 (kill-ring-save (point) (mark t))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
529 (mouse-show-mark))
4751
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
530 (setq mouse-save-then-kill-posn
c63ce262aa4d (mouse-save-then-kill): If follows a multi-click selection,
Richard M. Stallman <rms@gnu.org>
parents: 4738
diff changeset
531 (list (car kill-ring) (point) click-posn))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
532
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
533 (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
534 (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
535 (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
536 (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
537 (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
538
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
539 ;; An overlay which records the current secondary selection
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
540 ;; 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
541 ;; May be nil.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
542 (defvar mouse-secondary-overlay nil)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
543
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
544 ;; 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
545 ;; May be nil.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
546 (defvar mouse-secondary-start nil)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
547
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
548 (defun mouse-start-secondary (click)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
549 "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
550 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
551 and complete the secondary selection."
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
552 (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
553 (mouse-minibuffer-check click)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
554 (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
555 (save-excursion
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
556 (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
557 ;; 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
558 (if mouse-secondary-overlay
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
559 (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
560 (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
561 (progn
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
562 (or mouse-secondary-start
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
563 (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
564 (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
565
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
566 (defun mouse-set-secondary (click)
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
567 "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
568 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
569 (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
570 (mouse-minibuffer-check click)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
571 (let ((posn (event-start click))
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
572 beg
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
573 (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
574 (save-excursion
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
575 (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
576 (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
577 (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
578 (if mouse-secondary-overlay
7747dabf897f (mouse-secondary-save-then-kill): Don't switch windows.
Richard M. Stallman <rms@gnu.org>
parents: 3808
diff changeset
579 (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
580 (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
581 (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
582
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
583 (defun mouse-drag-secondary (start-event)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
584 "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
585 Highlight the drag area as you move the mouse.
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
586 This must be bound to a button-down mouse event."
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
587 (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
588 (mouse-minibuffer-check start-event)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
589 (let* ((start-posn (event-start start-event))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
590 (start-point (posn-point start-posn))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
591 (start-window (posn-window start-posn))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
592 (start-frame (window-frame start-window))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
593 (bounds (window-edges start-window))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
594 (top (nth 1 bounds))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
595 (bottom (if (window-minibuffer-p start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
596 (nth 3 bounds)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
597 ;; Don't count the mode line.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
598 (1- (nth 3 bounds))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
599 (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
600 (save-excursion
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
601 (set-buffer (window-buffer start-window))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
602 (setq mouse-selection-click-count click-count)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
603 (or mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
604 (setq mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
605 (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
606 (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
607 (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
608 ;; 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
609 ;; of one word or line.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
610 (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
611 (set-marker mouse-secondary-start nil)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
612 (move-overlay mouse-secondary-overlay 1 1
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
613 (window-buffer start-window))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
614 (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
615 (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
616 ;; 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
617 (or mouse-secondary-start
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
618 (setq mouse-secondary-start (make-marker)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
619 (set-marker mouse-secondary-start start-point)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
620 (delete-overlay mouse-secondary-overlay))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
621 (let (event end end-point)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
622 (track-mouse
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
623 (while (progn
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
624 (setq event (read-event))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
625 (or (mouse-movement-p event)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
626 (eq (car-safe event) 'switch-frame)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
627
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
628 (if (eq (car-safe event) 'switch-frame)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
629 nil
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
630 (setq end (event-end event)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
631 end-point (posn-point end))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
632 (cond
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
633
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
634 ;; Ignore switch-frame events.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
635 ((eq (car-safe event) 'switch-frame))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
636
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
637 ;; Are we moving within the original window?
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
638 ((and (eq (posn-window end) start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
639 (integer-or-marker-p end-point))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
640 (if (/= start-point end-point)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
641 (set-marker mouse-secondary-start nil))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
642 (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
643 click-count)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
644 (move-overlay mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
645 (car range) (nth 1 range))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
646
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
647 ;; Are we moving on a different window on the same frame?
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
648 ((and (windowp (posn-window end))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
649 (eq (window-frame (posn-window end)) start-frame))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
650 (let ((mouse-row
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
651 (+ (nth 1 (window-edges (posn-window end)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
652 (cdr (posn-col-row end)))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
653 (cond
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
654 ((< mouse-row top)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
655 (mouse-scroll-subr
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
656 (- mouse-row top) mouse-secondary-overlay start-point))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
657 ((and (not (eobp))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
658 (>= mouse-row bottom))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
659 (mouse-scroll-subr (1+ (- mouse-row bottom))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
660 mouse-drag-overlay start-point)))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
661
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
662 (t
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
663 (let ((mouse-y (cdr (cdr (mouse-position))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
664 (menu-bar-lines (or (cdr (assq 'menu-bar-lines
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
665 (frame-parameters)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
666 0)))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
667
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
668 ;; Are we on the menu bar?
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
669 (and (integerp mouse-y) (< mouse-y menu-bar-lines)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
670 (mouse-scroll-subr (- mouse-y menu-bar-lines)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
671 mouse-secondary-overlay start-point))))))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
672
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
673 (if (and (eq (get (event-basic-type event) 'event-kind) 'mouse-click)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
674 (eq (posn-window (event-end event)) start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
675 (numberp (posn-point (event-end event))))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
676 (if (marker-position mouse-secondary-start)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
677 (save-window-excursion
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
678 (delete-overlay mouse-secondary-overlay)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
679 (x-set-selection 'SECONDARY nil)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
680 (select-window start-window)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
681 (save-excursion
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
682 (goto-char mouse-secondary-start)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
683 (sit-for 1)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
684 (x-set-selection
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
685 'SECONDARY
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
686 (buffer-substring (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
687 (overlay-end mouse-secondary-overlay)))))))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
688
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
689 (defun mouse-yank-secondary (click)
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
690 "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
691 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
692 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
693 regardless of where you click."
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
694 (interactive "e")
5799
13d7ce941848 (mouse-yank-secondary): Do move point.
Richard M. Stallman <rms@gnu.org>
parents: 5280
diff changeset
695 (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
696 (insert (x-get-selection 'SECONDARY)))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
697
5280
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
698 (defun mouse-kill-secondary ()
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
699 "Kill the text in the secondary selection.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
700 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
701 but it can work as either one.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
702
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
703 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
704 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
705 is to prevent accidents."
5280
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
706 (interactive)
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
707 (let* ((keys (this-command-keys))
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
708 (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
709 (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
710 (if (listp click)
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
711 (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
712 (current-buffer)))
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
713 (error "Select or click on the buffer where the secondary selection is")))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
714 (save-excursion
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
715 (set-buffer (overlay-buffer mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
716 (kill-region (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
717 (overlay-end mouse-secondary-overlay)))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
718 (delete-overlay mouse-secondary-overlay)
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
719 (x-set-selection 'SECONDARY nil)
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
720 (setq mouse-secondary-overlay nil))
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
721
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
722 (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
723 "Save text to point in kill ring; the second time, kill the text.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
724 If the text between point and the mouse is the same as what's
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
725 at the front of the kill ring, this deletes the text.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
726 Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
727 which prepares for a second click to delete the text.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
728
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
729 If you have selected words or lines, this command extends the
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
730 selection through the word or line clicked on. If you do this
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
731 again in a different position, it extends the selection again.
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
732 If you do this twice in the same position, the selection is killed."
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
733 (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
734 (mouse-minibuffer-check click)
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
735 (let ((posn (event-start click))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
736 (click-posn (posn-point (event-start click)))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
737 ;; 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
738 ;; prevent setting this-command to kill-region.
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
739 (this-command this-command))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
740 (or (eq (window-buffer (posn-window posn))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
741 (or (and mouse-secondary-overlay
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
742 (overlay-buffer mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
743 (if mouse-secondary-start
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
744 (marker-buffer mouse-secondary-start))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
745 (error "Wrong buffer"))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
746 (save-excursion
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
747 (set-buffer (window-buffer (posn-window posn)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
748 (if (> (mod mouse-selection-click-count 3) 0)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
749 (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
750 (equal click-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
751 (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
752 ;; 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
753 (let* ((range
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
754 (mouse-start-end click-posn click-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
755 mouse-selection-click-count)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
756 ;; 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
757 ;; 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
758 (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
759 (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
760 (move-overlay mouse-secondary-overlay (car range)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
761 (overlay-end mouse-secondary-overlay))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
762 (move-overlay mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
763 (overlay-start mouse-secondary-overlay)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
764 (nth 1 range)))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
765 ;; 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
766 ;; Replace it with the extended region.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
767 ;; (It would be annoying to make a separate entry.)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
768 (setcar kill-ring (buffer-substring
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
769 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
770 (overlay-end mouse-secondary-overlay)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
771 (if interprogram-cut-function
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
772 (funcall interprogram-cut-function (car kill-ring)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
773 ;; 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
774 (setq mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
775 (list (car kill-ring) (point) click-posn)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
776 ;; 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
777 ;; that time kill.
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
778 (progn
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
779 (mouse-save-then-kill-delete-region
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
780 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
781 (overlay-end mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
782 (setq mouse-save-then-kill-posn nil)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
783 (setq mouse-selection-click-count 0)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
784 (delete-overlay mouse-secondary-overlay)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
785 (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
786 mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
787 (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
788 (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
789 ;; 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
790 ;; 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
791 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
792 (mouse-save-then-kill-delete-region
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
793 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
794 (overlay-end mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
795 (setq mouse-save-then-kill-posn nil)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
796 (delete-overlay mouse-secondary-overlay))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
797 (if (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
798 ;; We have a selection, so adjust it.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
799 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
800 (if (numberp click-posn)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
801 (progn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
802 ;; 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
803 ;; 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
804 (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
805 (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
806 (move-overlay mouse-secondary-overlay click-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
807 (overlay-end mouse-secondary-overlay))
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
808 (move-overlay mouse-secondary-overlay
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
809 (overlay-start mouse-secondary-overlay)
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
810 click-posn))
5153
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
811 (setq deactivate-mark nil)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
812 (setcar kill-ring (buffer-substring
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
813 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
814 (overlay-end mouse-secondary-overlay)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
815 (if interprogram-cut-function
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
816 (funcall interprogram-cut-function (car kill-ring))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
817 (if mouse-secondary-start
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
818 ;; 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
819 ;; so put the other end here.
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
820 (let ((start (+ 0 mouse-secondary-start)))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
821 (kill-ring-save start click-posn)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
822 (if mouse-secondary-overlay
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
823 (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
824 (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
825 (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
826 (setq mouse-save-then-kill-posn
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
827 (list (car kill-ring) (point) click-posn))))
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
828 (x-set-selection 'SECONDARY
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
829 (if (overlay-buffer mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
830 (buffer-substring
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
831 (overlay-start mouse-secondary-overlay)
27afcc69725a (mouse-save-then-kill-delete-region):
Richard M. Stallman <rms@gnu.org>
parents: 5027
diff changeset
832 (overlay-end mouse-secondary-overlay)))))))
3808
d852157f581a (mouse-start-secondary): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3712
diff changeset
833
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
834 (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
835 "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
836 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
837 and selects that window."
1113
0ffcf74fb8ad entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 1100
diff changeset
838 (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
839 (mouse-minibuffer-check event)
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
840 (let ((menu
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
841 (list "Buffer Menu"
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
842 (cons "Select Buffer"
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
843 (let ((tail (buffer-list))
3899
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
844 (maxbuf 0)
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
845 head)
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
846 (while tail
3899
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
847 (or (eq ?\ (aref (buffer-name (car tail)) 0))
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
848 (setq maxbuf
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
849 (max maxbuf
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
850 (length (buffer-name (car tail))))))
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
851 (setq tail (cdr tail)))
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
852 (setq tail (buffer-list))
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
853 (while tail
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
854 (let ((elt (car tail)))
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
855 (if (not (string-match "^ "
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
856 (buffer-name elt)))
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
857 (setq head (cons
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
858 (cons
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
859 (format
3899
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
860 (format "%%%ds %%s%%s %%s"
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
861 maxbuf)
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
862 (buffer-name elt)
3899
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
863 (if (buffer-modified-p elt)
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
864 "*" " ")
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
865 (save-excursion
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
866 (set-buffer elt)
a0655a72182b (mouse-buffer-menu): Include % and * in each item.
Richard M. Stallman <rms@gnu.org>
parents: 3823
diff changeset
867 (if buffer-read-only "%" " "))
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
868 (or (buffer-file-name elt) ""))
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
869 elt)
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
870 head))))
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
871 (setq tail (cdr tail)))
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
872 (reverse head))))))
1728
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
873 (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
874 (window (posn-window (event-start event))))
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
875 (if buf
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
876 (progn
3420
08adfe96ca93 (mouse-buffer-menu): Don't select the event's window,
Richard M. Stallman <rms@gnu.org>
parents: 3231
diff changeset
877 (or (framep window) (select-window window))
1728
2a49d509b30d (mouse-buffer-menu): Select the window clicked on.
Richard M. Stallman <rms@gnu.org>
parents: 1421
diff changeset
878 (switch-to-buffer buf))))))
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
879
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
880 ;;; These need to be rewritten for the new scroll bar implementation.
66
5793fbcb9ac1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
881
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
882 ;;;!! ;; Commands for the scroll bar.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
883 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
884 ;;;!! (defun mouse-scroll-down (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
885 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
886 ;;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
887 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
888 ;;;!! (defun mouse-scroll-up (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
889 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
890 ;;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
891 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
892 ;;;!! (defun mouse-scroll-down-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
893 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
894 ;;;!! (scroll-down nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
895 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
896 ;;;!! (defun mouse-scroll-up-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
897 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
898 ;;;!! (scroll-up nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
899 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
900 ;;;!! (defun mouse-scroll-move-cursor (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
901 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
902 ;;;!! (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
903 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
904 ;;;!! (defun mouse-scroll-absolute (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
905 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
906 ;;;!! (let* ((pos (car event))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
907 ;;;!! (position (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
908 ;;;!! (length (car (cdr pos))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
909 ;;;!! (if (<= length 0) (setq length 1))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
910 ;;;!! (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
911 ;;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
912 ;;;!! position)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
913 ;;;!! length)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
914 ;;;!! scale-factor)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
915 ;;;!! (goto-char newpos)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
916 ;;;!! (recenter '(4)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
917 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
918 ;;;!! (defun mouse-scroll-left (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
919 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
920 ;;;!! (scroll-left (1+ (car (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
921 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
922 ;;;!! (defun mouse-scroll-right (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
923 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
924 ;;;!! (scroll-right (1+ (car (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
925 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
926 ;;;!! (defun mouse-scroll-left-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
927 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
928 ;;;!! (scroll-left nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
929 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
930 ;;;!! (defun mouse-scroll-right-full ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
931 ;;;!! (interactive "@")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
932 ;;;!! (scroll-right nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
933 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
934 ;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
935 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
936 ;;;!! (move-to-column (1+ (car (mouse-coords click)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
937 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
938 ;;;!! (defun mouse-scroll-absolute-horizontally (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
939 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
940 ;;;!! (let* ((pos (car event))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
941 ;;;!! (position (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
942 ;;;!! (length (car (cdr pos))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
943 ;;;!! (set-window-hscroll (selected-window) 33)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
944 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
945 ;;;!! (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
946 ;;;!! (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
947 ;;;!! (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
948 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
949 ;;;!! (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
950 ;;;!! (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
951 ;;;!! (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
952 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
953 ;;;!! (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
954 ;;;!! (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
955 ;;;!! (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
956 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
957 ;;;!! (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
958 ;;;!! (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
959 ;;;!! (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
960 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
961 ;;;!! (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
962 ;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
963 ;;;!! 'mouse-scroll-absolute-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
964 ;;;!! (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
965 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
966 ;;;!! (global-set-key [horizontal-slider mouse-1]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
967 ;;;!! 'mouse-scroll-move-cursor-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
968 ;;;!! (global-set-key [horizontal-slider mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
969 ;;;!! 'mouse-scroll-move-cursor-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
970 ;;;!! (global-set-key [horizontal-slider mouse-3]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
971 ;;;!! 'mouse-scroll-move-cursor-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
972 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
973 ;;;!! (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
974 ;;;!! (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
975 ;;;!! (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
976 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
977 ;;;!! (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
978 ;;;!! (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
979 ;;;!! (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
980 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
981 ;;;!! (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
982 ;;;!! 'mouse-split-window-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
983 ;;;!! (global-set-key [mode-line S-mouse-2]
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
984 ;;;!! 'mouse-split-window-horizontally)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
985 ;;;!! (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
986 ;;;!! 'mouse-split-window)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
987
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
988 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
989 ;;;!! ;;;; Here are experimental things being tested. Mouse events
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
990 ;;;!! ;;;; are of the form:
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
991 ;;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
992 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
993 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
994 ;;;!! ;;;; Dynamically track mouse coordinates
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
995 ;;;!! ;;;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
996 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
997 ;;;!! ;;(defun track-mouse (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
998 ;;;!! ;; "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
999 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1000 ;;;!! ;; (while mouse-grabbed
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1001 ;;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1002 ;;;!! ;; (abs-x (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1003 ;;;!! ;; (abs-y (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1004 ;;;!! ;; (relative-coordinate (coordinates-in-window-p
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1005 ;;;!! ;; (list (car pos) (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1006 ;;;!! ;; (selected-window))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1007 ;;;!! ;; (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1008 ;;;!! ;; (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
1009 ;;;!! ;; (car relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1010 ;;;!! ;; (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1011 ;;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1012 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1013 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1014 ;;;!! ;; 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
1015 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1016 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1017 ;;;!! ;;(require 'backquote)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1018 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1019 ;;;!! ;;(defun mouse-select-buffer-line (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1020 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1021 ;;;!! ;; (let ((relative-coordinate
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1022 ;;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1023 ;;;!! ;; (abs-y (car (cdr (car event)))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1024 ;;;!! ;; (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1025 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1026 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1027 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1028 ;;;!! ;; (x-draw-rectangle
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1029 ;;;!! ;; (selected-screen)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1030 ;;;!! ;; abs-y 0
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1031 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1032 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1033 ;;;!! ;; (end-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1034 ;;;!! ;; (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1035 ;;;!! ;; (beginning-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1036 ;;;!! ;; (- (region-end) (region-beginning))) 1))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1037 ;;;!! ;; (sit-for 1)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1038 ;;;!! ;; (x-erase-rectangle (selected-screen))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1039 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1040 ;;;!! ;;(defvar last-line-drawn nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1041 ;;;!! ;;(defvar begin-delim "[^ \t]")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1042 ;;;!! ;;(defvar end-delim "[^ \t]")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1043 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1044 ;;;!! ;;(defun mouse-boxing (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1045 ;;;!! ;; (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1046 ;;;!! ;; (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1047 ;;;!! ;; (let ((screen (selected-screen)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1048 ;;;!! ;; (while (= (x-mouse-events) 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1049 ;;;!! ;; (let* ((pos (read-mouse-position screen))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1050 ;;;!! ;; (abs-x (car pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1051 ;;;!! ;; (abs-y (cdr pos))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1052 ;;;!! ;; (relative-coordinate
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1053 ;;;!! ;; (coordinates-in-window-p (` ((, abs-x) (, abs-y)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1054 ;;;!! ;; (selected-window)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1055 ;;;!! ;; (begin-reg nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1056 ;;;!! ;; (end-reg nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1057 ;;;!! ;; (end-column nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1058 ;;;!! ;; (begin-column nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1059 ;;;!! ;; (if (and (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1060 ;;;!! ;; (or (not last-line-drawn)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1061 ;;;!! ;; (not (= last-line-drawn abs-y))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1062 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1063 ;;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1064 ;;;!! ;; (if (= (following-char) 10)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1065 ;;;!! ;; ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1066 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1067 ;;;!! ;; (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
1068 ;;;!! ;; (setq begin-column (1- (current-column)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1069 ;;;!! ;; (end-of-line)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1070 ;;;!! ;; (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
1071 ;;;!! ;; (setq end-column (1+ (current-column)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1072 ;;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1073 ;;;!! ;; (x-draw-rectangle screen
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1074 ;;;!! ;; (setq last-line-drawn abs-y)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1075 ;;;!! ;; begin-column
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1076 ;;;!! ;; (- end-column begin-column) 1))))))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1077 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1078 ;;;!! ;;(defun mouse-erase-box ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1079 ;;;!! ;; (interactive)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1080 ;;;!! ;; (if last-line-drawn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1081 ;;;!! ;; (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1082 ;;;!! ;; (x-erase-rectangle (selected-screen))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1083 ;;;!! ;; (setq last-line-drawn nil))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1084 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1085 ;;;!! ;;; (defun test-x-rectangle ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1086 ;;;!! ;;; (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
1087 ;;;!! ;;; (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
1088 ;;;!! ;;; (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
1089 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1090 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1091 ;;;!! ;; 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
1092 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1093 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1094 ;;;!! (defvar double-start nil)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1095 ;;;!! (defconst double-click-interval 300
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1096 ;;;!! "Max ticks between clicks")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1097 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1098 ;;;!! (defun double-down (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1099 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1100 ;;;!! (if double-start
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1101 ;;;!! (let ((interval (- (nth 4 event) double-start)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1102 ;;;!! (if (< interval double-click-interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1103 ;;;!! (progn
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1104 ;;;!! (backward-up-list 1)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1105 ;;;!! ;; (message "Interval %d" interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1106 ;;;!! (sleep-for 1)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1107 ;;;!! (setq double-start nil))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1108 ;;;!! (setq double-start (nth 4 event))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1109 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1110 ;;;!! (defun double-up (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1111 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1112 ;;;!! (and double-start
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1113 ;;;!! (> (- (nth 4 event ) double-start) double-click-interval)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1114 ;;;!! (setq double-start nil)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1115 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1116 ;;;!! ;;; (defun x-test-doubleclick ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1117 ;;;!! ;;; (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
1118 ;;;!! ;;; (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
1119 ;;;!! ;;; (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
1120 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1121 ;;;!! ;;
1980
263033210413 * mouse.el (mouse-split-window-vertically): If the user clicks too
Jim Blandy <jimb@redhat.com>
parents: 1821
diff changeset
1122 ;;;!! ;; 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
1123 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1124 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1125 ;;;!! (defvar scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1126 ;;;!! (defconst scroll-speed 1)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1127 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1128 ;;;!! (defun incr-scroll-down (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1129 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1130 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1131 ;;;!! (incremental-scroll scroll-speed))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1132 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1133 ;;;!! (defun incr-scroll-up (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1134 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1135 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1136 ;;;!! (incremental-scroll (- scroll-speed)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1137 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1138 ;;;!! (defun incremental-scroll (n)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1139 ;;;!! (while (= (x-mouse-events) 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1140 ;;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1141 ;;;!! (scroll-down n)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1142 ;;;!! (sit-for 300 t)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1143 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1144 ;;;!! (defun incr-scroll-stop (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1145 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1146 ;;;!! (message "Scrolled %d lines" scrolled-lines)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1147 ;;;!! (setq scrolled-lines 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1148 ;;;!! (sleep-for 1))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1149 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1150 ;;;!! ;;; (defun x-testing-scroll ()
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1151 ;;;!! ;;; (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
1152 ;;;!! ;;; (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
1153 ;;;!! ;;; (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
1154 ;;;!! ;;; (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
1155 ;;;!! ;;; (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
1156 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1157 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1158 ;;;!! ;; 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
1159 ;;;!! ;;
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1160 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1161 ;;;!! (defun mouse-kill-rectangle (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1162 ;;;!! "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
1163 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1164 ;;;!! (let ((point-save (point)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1165 ;;;!! (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1166 ;;;!! (mouse-set-point event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1167 ;;;!! (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1168 ;;;!! (if (> point-save (point))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1169 ;;;!! (kill-rectangle (point) point-save)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1170 ;;;!! (kill-rectangle point-save (point))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1171 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1172 ;;;!! (defun mouse-open-rectangle (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1173 ;;;!! "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
1174 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1175 ;;;!! (let ((point-save (point)))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1176 ;;;!! (save-excursion
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1177 ;;;!! (mouse-set-point event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1178 ;;;!! (push-mark nil t)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1179 ;;;!! (if (> point-save (point))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1180 ;;;!! (open-rectangle (point) point-save)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1181 ;;;!! (open-rectangle point-save (point))))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1182 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1183 ;;;!! ;; Must be a better way to do this.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1184 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1185 ;;;!! (defun mouse-multiple-insert (n char)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1186 ;;;!! (while (> n 0)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1187 ;;;!! (insert char)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1188 ;;;!! (setq n (1- n))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1189 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1190 ;;;!! ;; 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
1191 ;;;!!
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1192 ;;;!! (defun mouse-move-text (event)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1193 ;;;!! "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
1194 ;;;!! (interactive "@e")
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1195 ;;;!! (let* ((relative-coordinate
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1196 ;;;!! (coordinates-in-window-p (car event) (selected-window))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1197 ;;;!! (if (consp relative-coordinate)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1198 ;;;!! (cond ((> (current-column) (car relative-coordinate))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1199 ;;;!! (delete-char
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1200 ;;;!! (- (car relative-coordinate) (current-column))))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1201 ;;;!! ((< (current-column) (car relative-coordinate))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1202 ;;;!! (mouse-multiple-insert
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1203 ;;;!! (- (car relative-coordinate) (current-column)) " "))
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1204 ;;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1205
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1206 ;; Choose a completion with the mouse.
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1207
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1208 (defun mouse-choose-completion (event)
4371
fb0e37e7afae (mouse-choose-completion): Actually choose that alternative,
Richard M. Stallman <rms@gnu.org>
parents: 4294
diff changeset
1209 "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
1210 (interactive "e")
4788
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1211 (let ((buffer (window-buffer))
3182c0f7ace4 (mouse-delete-max-match): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4751
diff changeset
1212 choice)
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1213 (save-excursion
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1214 (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
1215 (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
1216 (setq buffer completion-reference-buffer))
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1217 (save-excursion
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1218 (goto-char (posn-point (event-start event)))
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1219 (skip-chars-backward "^ \t\n")
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1220 (let ((beg (point)))
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1221 (skip-chars-forward "^ \t\n")
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1222 (setq choice (buffer-substring beg (point))))))
6231
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
1223 (let ((owindow (selected-window)))
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
1224 (select-window (posn-window (event-start event)))
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
1225 (bury-buffer)
c2bb4c368553 (mouse-choose-completion): Bury the completion buffer.
Richard M. Stallman <rms@gnu.org>
parents: 6163
diff changeset
1226 (select-window owindow))
6548
2b0355912ba6 (mouse-choose-completion): Use choose-completion-string.
Richard M. Stallman <rms@gnu.org>
parents: 6301
diff changeset
1227 (choose-completion-string choice buffer)))
4081
da352b92ca90 (mouse-choose-completion): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3961
diff changeset
1228
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1229 ;; Font selection.
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1230
4294
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1231 (defun font-menu-add-default ()
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1232 (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
1233 (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
1234 (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
1235 (if (assoc "Default" elt)
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1236 (delete (assoc "Default" elt) elt))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1237 (setcdr elt
4562
477fbf60722b (font-menu-add-default): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 4554
diff changeset
1238 (cons (list "Default"
4294
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1239 (cdr (assq 'font (frame-parameters (selected-frame)))))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1240 (cdr elt)))))
644e33e3ab38 (font-menu-add-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 4274
diff changeset
1241
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1242 (defvar x-fixed-font-alist
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1243 '("Font menu"
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1244 ("Misc"
5280
6a260dd9ee05 (mouse-kill-secondary): Get rid of CLICK argument.
Richard M. Stallman <rms@gnu.org>
parents: 5198
diff changeset
1245 ("6x10" "-misc-fixed-medium-r-normal--10-100-75-75-c-60-*-1")
4274
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1246 ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1247 ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1248 ("lucida 13"
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1249 "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1250 ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1251 ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1252 ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1253 ("")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1254 ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1255 ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1256 ("clean 8x10" "-schumacher-clean-medium-r-normal--*-100-*-*-c-*-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1257 ("clean 8x16" "-schumacher-clean-medium-r-normal--*-160-*-*-c-*-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1258 ("")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1259 ("sony 8x16" "-sony-fixed-medium-r-normal--16-120-100-100-c-80-*-1")
6e46ab2ea271 (x-fixed-font-alist): Give some fonts long patterns.
Richard M. Stallman <rms@gnu.org>
parents: 4221
diff changeset
1260 ("")
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1261 ("fixed" "fixed")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1262 ("10x20" "10x20")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1263 ("11x18" "11x18")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1264 ("12x24" "12x24"))
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1265 ;;; 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
1266 ;;; ("fg-18" "fg-18")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1267 ;;; ("fg-25" "fg-25")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1268 ;;; ("lucidasanstypewriter-12" "lucidasanstypewriter-12")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1269 ;;; ("lucidasanstypewriter-bold-14" "lucidasanstypewriter-bold-14")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1270 ;;; ("lucidasanstypewriter-bold-24" "lucidasanstypewriter-bold-24")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1271 ;;; ("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
1272 ;;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1273 ("Courier"
3231
fb322590dda0 (x-fixed-font-alist): Specify field 7, not field 6.
Richard M. Stallman <rms@gnu.org>
parents: 3119
diff changeset
1274 ("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
1275 ("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
1276 ("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
1277 ("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
1278 ("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
1279 ("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
1280 ("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
1281 ("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
1282 ("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
1283 ("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
1284 ("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
1285 ("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
1286 ("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
1287 ("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
1288 ("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
1289 ("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
1290 ("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
1291 ("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
1292 ("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
1293 ("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
1294 ("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
1295 ("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
1296 ("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
1297 ("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
1298 )
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1299 "X fonts suitable for use in Emacs.")
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1300
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1301 (defun mouse-set-font (&optional font)
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1302 "Select an emacs font from a list of known good fonts"
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1303 (interactive
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1304 (x-popup-menu last-nonmenu-event x-fixed-font-alist))
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1305 (if font
4220
c89f55065260 (mouse-set-font): Update faces bold, italic and bold-italic.
Richard M. Stallman <rms@gnu.org>
parents: 4200
diff changeset
1306 (progn (modify-frame-parameters (selected-frame)
c89f55065260 (mouse-set-font): Update faces bold, italic and bold-italic.
Richard M. Stallman <rms@gnu.org>
parents: 4200
diff changeset
1307 (list (cons 'font font)))
c89f55065260 (mouse-set-font): Update faces bold, italic and bold-italic.
Richard M. Stallman <rms@gnu.org>
parents: 4200
diff changeset
1308 ;; Update some standard faces too.
c89f55065260 (mouse-set-font): Update faces bold, italic and bold-italic.
Richard M. Stallman <rms@gnu.org>
parents: 4200
diff changeset
1309 (set-face-font 'bold nil (selected-frame))
c89f55065260 (mouse-set-font): Update faces bold, italic and bold-italic.
Richard M. Stallman <rms@gnu.org>
parents: 4200
diff changeset
1310 (make-face-bold 'bold (selected-frame) t)
c89f55065260 (mouse-set-font): Update faces bold, italic and bold-italic.
Richard M. Stallman <rms@gnu.org>
parents: 4200
diff changeset
1311 (set-face-font 'italic nil (selected-frame))
c89f55065260 (mouse-set-font): Update faces bold, italic and bold-italic.
Richard M. Stallman <rms@gnu.org>
parents: 4200
diff changeset
1312 (make-face-italic 'italic (selected-frame) t)
c89f55065260 (mouse-set-font): Update faces bold, italic and bold-italic.
Richard M. Stallman <rms@gnu.org>
parents: 4200
diff changeset
1313 (set-face-font 'bold-italic nil (selected-frame))
5198
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1314 (make-face-bold-italic 'bold-italic (selected-frame) t)
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1315 ;; Update any nonstandard faces whose definition is
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1316 ;; "a bold/italic/bold&italic version of the frame's font".
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1317 (let ((rest global-face-data))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1318 (while rest
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1319 (condition-case nil
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1320 (if (listp (face-font (cdr (car rest))))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1321 (let ((bold (memq 'bold (face-font (cdr (car rest)))))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1322 (italic (memq 'italic (face-font (cdr (car rest))))))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1323 (if (and bold italic)
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1324 (make-face-bold-italic (car (car rest)) (selected-frame))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1325 (if bold
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1326 (make-face-bold (car (car rest)) (selected-frame))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1327 (if italic
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1328 (make-face-italic (car (car rest)) (selected-frame)))))))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1329 (error nil))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1330 (setq rest (cdr rest))))
1f14aa44c786 (mouse-set-font): Update nonstandard faces that are supposed
Richard M. Stallman <rms@gnu.org>
parents: 5153
diff changeset
1331 )))
465
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1332
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1333 ;;; Bindings for mouse commands.
36359663b6d8 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 303
diff changeset
1334
2799
93a5aef19835 (mouse-drag-region): New command, on down-mouse-1.
Richard M. Stallman <rms@gnu.org>
parents: 2632
diff changeset
1335 (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
1336 (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
1337 (global-set-key [drag-mouse-1] 'mouse-set-region)
1057
d9775f33488d *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1056
diff changeset
1338
4738
76a2ea569de5 (mouse-set-region): Put region in kill ring.
Richard M. Stallman <rms@gnu.org>
parents: 4592
diff changeset
1339 ;; 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
1340 (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
1341 (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
1342
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1343 (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
1344 (global-set-key [mouse-3] 'mouse-save-then-kill)
705
c7d478752305 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 659
diff changeset
1345
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1346 ;; 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
1347 ;; event to make the selection, saving a click.
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1348 (global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1765
diff changeset
1349 (global-set-key [C-down-mouse-3] 'mouse-set-font)
1100
5b3b202a84c8 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1064
diff changeset
1350
1056
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
1351 ;; Replaced with dragging mouse-1
a7fc54083464 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 1039
diff changeset
1352 ;; (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
1353
6090
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
1354 (global-set-key [mode-line mouse-1] 'mouse-select-window)
e7c900a464d3 (help-menu-map): Variable deleted, and its binding.
Richard M. Stallman <rms@gnu.org>
parents: 6003
diff changeset
1355 (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
1356 (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
1357 (global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
584
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
1358
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
1359 (provide 'mouse)
4cd7543be581 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 465
diff changeset
1360
659
505130d1ddf8 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 584
diff changeset
1361 ;;; mouse.el ends here