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