![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to x-mouse.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to x-mouse.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 1: ;; Mouse support for X window system.
2: ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: (provide 'x-mouse)
23:
24: (defconst x-button-right (char-to-string 0))
25: (defconst x-button-middle (char-to-string 1))
26: (defconst x-button-left (char-to-string 2))
27:
28: (defconst x-button-right-up (char-to-string 4))
29: (defconst x-button-middle-up (char-to-string 5))
30: (defconst x-button-left-up (char-to-string 6))
31:
32: (defconst x-button-s-right (char-to-string 16))
33: (defconst x-button-s-middle (char-to-string 17))
34: (defconst x-button-s-left (char-to-string 18))
35:
36: (defconst x-button-s-right-up (char-to-string 20))
37: (defconst x-button-s-middle-up (char-to-string 21))
38: (defconst x-button-s-left-up (char-to-string 22))
39:
40: (defconst x-button-m-right (char-to-string 32))
41: (defconst x-button-m-middle (char-to-string 33))
42: (defconst x-button-m-left (char-to-string 34))
43:
44: (defconst x-button-m-right-up (char-to-string 36))
45: (defconst x-button-m-middle-up (char-to-string 37))
46: (defconst x-button-m-left-up (char-to-string 38))
47:
48: (defconst x-button-c-right (char-to-string 64))
49: (defconst x-button-c-middle (char-to-string 65))
50: (defconst x-button-c-left (char-to-string 66))
51:
52: (defconst x-button-c-right-up (char-to-string 68))
53: (defconst x-button-c-middle-up (char-to-string 69))
54: (defconst x-button-c-left-up (char-to-string 70))
55:
56: (defconst x-button-m-s-right (char-to-string 48))
57: (defconst x-button-m-s-middle (char-to-string 49))
58: (defconst x-button-m-s-left (char-to-string 50))
59:
60: (defconst x-button-m-s-right-up (char-to-string 52))
61: (defconst x-button-m-s-middle-up (char-to-string 53))
62: (defconst x-button-m-s-left-up (char-to-string 54))
63:
64: (defconst x-button-c-s-right (char-to-string 80))
65: (defconst x-button-c-s-middle (char-to-string 81))
66: (defconst x-button-c-s-left (char-to-string 82))
67:
68: (defconst x-button-c-s-right-up (char-to-string 84))
69: (defconst x-button-c-s-middle-up (char-to-string 85))
70: (defconst x-button-c-s-left-up (char-to-string 86))
71:
72: (defconst x-button-c-m-right (char-to-string 96))
73: (defconst x-button-c-m-middle (char-to-string 97))
74: (defconst x-button-c-m-left (char-to-string 98))
75:
76: (defconst x-button-c-m-right-up (char-to-string 100))
77: (defconst x-button-c-m-middle-up (char-to-string 101))
78: (defconst x-button-c-m-left-up (char-to-string 102))
79:
80: (defconst x-button-c-m-s-right (char-to-string 112))
81: (defconst x-button-c-m-s-middle (char-to-string 113))
82: (defconst x-button-c-m-s-left (char-to-string 114))
83:
84: (defconst x-button-c-m-s-right-up (char-to-string 116))
85: (defconst x-button-c-m-s-middle-up (char-to-string 117))
86: (defconst x-button-c-m-s-left-up (char-to-string 118))
87:
88: (defvar x-process-mouse-hook nil
89: "Hook to run after each mouse event is processed. Should take two
90: arguments; the first being a list (XPOS YPOS) corresponding to character
91: offset from top left of screen and the second being a specifier for the
92: buttons/keys.
93:
94: This will normally be set on a per-buffer basis.")
95:
96: (defun x-flush-mouse-queue ()
97: "Process all queued mouse events."
98: ;; A mouse event causes a special character sequence to be given
99: ;; as keyboard input. That runs this function, which process all
100: ;; queued mouse events and returns.
101: (interactive)
102: (while (> (x-mouse-events) 0)
103: (x-proc-mouse-event)
104: (and (boundp 'x-process-mouse-hook)
105: (symbol-value 'x-process-mouse-hook)
106: (funcall x-process-mouse-hook x-mouse-pos x-mouse-item))))
107:
108: (define-key global-map "\C-c\C-m" 'x-flush-mouse-queue)
109: (define-key global-map "\C-x\C-@" 'x-flush-mouse-queue)
110:
111: (defun x-mouse-select (arg)
112: "Select Emacs window the mouse is on."
113: (let ((start-w (selected-window))
114: (done nil)
115: (w (selected-window))
116: (rel-coordinate nil))
117: (while (and (not done)
118: (null (setq rel-coordinate
119: (coordinates-in-window-p arg w))))
120: (setq w (next-window w))
121: (if (eq w start-w)
122: (setq done t)))
123: (select-window w)
124: rel-coordinate))
125:
126: (defun x-mouse-keep-one-window (arg)
127: "Select Emacs window mouse is on, then kill all other Emacs windows."
128: (if (x-mouse-select arg)
129: (delete-other-windows)))
130:
131: (defun x-mouse-select-and-split (arg)
132: "Select Emacs window mouse is on, then split it vertically in half."
133: (if (x-mouse-select arg)
134: (split-window-vertically nil)))
135:
136: (defun x-mouse-set-point (arg)
137: "Select Emacs window mouse is on, and move point to mouse position."
138: (let* ((relative-coordinate (x-mouse-select arg))
139: (rel-x (car relative-coordinate))
140: (rel-y (car (cdr relative-coordinate))))
141: (if relative-coordinate
142: (progn
143: (move-to-window-line rel-y)
144: (move-to-column (+ rel-x (current-column)))))))
145:
146: (defun x-mouse-set-mark (arg)
147: "Select Emacs window mouse is on, and set mark at mouse position.
148: Display cursor at that position for a second."
149: (if (x-mouse-select arg)
150: (let ((point-save (point)))
151: (unwind-protect
152: (progn (x-mouse-set-point arg)
153: (push-mark nil t)
154: (sit-for 1))
155: (goto-char point-save)))))
156:
157: (defun x-cut-text (arg &optional kill)
158: "Copy text between point and mouse position into window system cut buffer.
159: Save in Emacs kill ring also."
160: (if (coordinates-in-window-p arg (selected-window))
161: (save-excursion
162: (let ((opoint (point))
163: beg end)
164: (x-mouse-set-point arg)
165: (setq beg (min opoint (point))
166: end (max opoint (point)))
167: (x-store-cut-buffer (buffer-substring beg end))
168: (copy-region-as-kill beg end)
169: (if kill (delete-region beg end))))
170: (message "Mouse not in selected window")))
171:
172: (defun x-paste-text (arg)
173: "Move point to mouse position and insert window system cut buffer contents."
174: (x-mouse-set-point arg)
175: (insert (x-get-cut-buffer)))
176:
177: (defun x-cut-and-wipe-text (arg)
178: "Kill text between point and mouse; also copy to window system cut buffer."
179: (x-cut-text arg t))
180:
181: (defun x-mouse-ignore (arg)
182: "Don't do anything.")
183:
184: (defun x-buffer-menu (arg)
185: "Pop up a menu of buffers for selection with the mouse."
186: (let ((menu
187: (list "Buffer Menu"
188: (cons "Select Buffer"
189: (let ((tail (buffer-list))
190: head)
191: (while tail
192: (let ((elt (car tail)))
193: (if (not (string-match "^ "
194: (buffer-name elt)))
195: (setq head (cons
196: (cons
197: (format
198: "%14s %s"
199: (buffer-name elt)
200: (or (buffer-file-name elt) ""))
201: elt)
202: head))))
203: (setq tail (cdr tail)))
204: (reverse head))))))
205: (switch-to-buffer (or (x-popup-menu arg menu) (current-buffer)))))
206:
207: (defun x-help (arg)
208: "Enter a menu-based help system."
209: (let ((selection
210: (x-popup-menu
211: arg
212: '("Help" ("Is there a command that..."
213: ("Command apropos" . command-apropos)
214: ("Apropos" . apropos))
215: ("Key Commands <==> Functions"
216: ("List all keystroke commands" . describe-bindings)
217: ("Describe key briefly" . describe-key-briefly)
218: ("Describe key verbose" . describe-key)
219: ("Describe Lisp function" . describe-function)
220: ("Where is this command" . where-is))
221: ("Manual and tutorial"
222: ("Info system" . info)
223: ("Invoke Emacs tutorial" . help-with-tutorial))
224: ("Odds and ends"
225: ("Last 100 Keystrokes" . view-lossage)
226: ("Describe syntax table" . describe-syntax))
227: ("Modes"
228: ("Describe current major mode" . describe-mode)
229: ("List all keystroke commands" . describe-bindings))
230: ("Administrivia"
231: ("View Emacs news" . view-emacs-news)
232: ("View the GNU Emacs license" . describe-copying)
233: ("Describe distribution" . describe-distribution)
234: ("Describe (non)warranty" . describe-no-warranty))))))
235: (and selection (call-interactively selection))))
236:
237: ; Prevent beeps on button-up. If the button isn't bound to anything, it
238: ; will beep on button-down.
239: (define-key mouse-map x-button-right-up 'x-mouse-ignore)
240: (define-key mouse-map x-button-middle-up 'x-mouse-ignore)
241: (define-key mouse-map x-button-left-up 'x-mouse-ignore)
242: (define-key mouse-map x-button-s-right-up 'x-mouse-ignore)
243: (define-key mouse-map x-button-s-middle-up 'x-mouse-ignore)
244: (define-key mouse-map x-button-s-left-up 'x-mouse-ignore)
245: (define-key mouse-map x-button-m-right-up 'x-mouse-ignore)
246: (define-key mouse-map x-button-m-middle-up 'x-mouse-ignore)
247: (define-key mouse-map x-button-m-left-up 'x-mouse-ignore)
248: (define-key mouse-map x-button-c-right-up 'x-mouse-ignore)
249: (define-key mouse-map x-button-c-middle-up 'x-mouse-ignore)
250: (define-key mouse-map x-button-c-left-up 'x-mouse-ignore)
251: (define-key mouse-map x-button-m-s-right-up 'x-mouse-ignore)
252: (define-key mouse-map x-button-m-s-middle-up 'x-mouse-ignore)
253: (define-key mouse-map x-button-m-s-left-up 'x-mouse-ignore)
254: (define-key mouse-map x-button-c-s-right-up 'x-mouse-ignore)
255: (define-key mouse-map x-button-c-s-middle-up 'x-mouse-ignore)
256: (define-key mouse-map x-button-c-s-left-up 'x-mouse-ignore)
257: (define-key mouse-map x-button-c-m-right-up 'x-mouse-ignore)
258: (define-key mouse-map x-button-c-m-middle-up 'x-mouse-ignore)
259: (define-key mouse-map x-button-c-m-left-up 'x-mouse-ignore)
260: (define-key mouse-map x-button-c-m-s-right-up 'x-mouse-ignore)
261: (define-key mouse-map x-button-c-m-s-middle-up 'x-mouse-ignore)
262: (define-key mouse-map x-button-c-m-s-left-up 'x-mouse-ignore)
263:
264: (define-key mouse-map x-button-c-s-left 'x-buffer-menu)
265: (define-key mouse-map x-button-c-s-middle 'x-help)
266: (define-key mouse-map x-button-c-s-right 'x-mouse-keep-one-window)
267: (define-key mouse-map x-button-s-middle 'x-cut-text)
268: (define-key mouse-map x-button-s-right 'x-paste-text)
269: (define-key mouse-map x-button-c-middle 'x-cut-and-wipe-text)
270: (define-key mouse-map x-button-c-right 'x-mouse-select-and-split)
271:
272: (if (= window-system-version 10)
273: (progn
274: (define-key mouse-map x-button-right 'x-mouse-select)
275: (define-key mouse-map x-button-left 'x-mouse-set-mark)
276: (define-key mouse-map x-button-middle 'x-mouse-set-point))
277: (define-key mouse-map x-button-right 'x-cut-text)
278: (define-key mouse-map x-button-left 'x-mouse-set-point)
279: (define-key mouse-map x-button-middle 'x-paste-text))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.