|
|
1.1 root 1: ;; Mouse support for X window system.
2: ;; Copyright (C) 1985 Richard M. Stallman.
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: (defconst x-button-right (char-to-string 0))
23: (defconst x-button-middle (char-to-string 1))
24: (defconst x-button-left (char-to-string 2))
25:
26: (defconst x-button-s-right (char-to-string 16))
27: (defconst x-button-s-middle (char-to-string 17))
28: (defconst x-button-s-left (char-to-string 18))
29:
30: (defconst x-button-m-right (char-to-string 32))
31: (defconst x-button-m-middle (char-to-string 33))
32: (defconst x-button-m-left (char-to-string 34))
33:
34: (defconst x-button-c-right (char-to-string 64))
35: (defconst x-button-c-middle (char-to-string 65))
36: (defconst x-button-c-left (char-to-string 66))
37:
38: (defconst x-button-m-s-right (char-to-string 48))
39: (defconst x-button-m-s-middle (char-to-string 49))
40: (defconst x-button-m-s-left (char-to-string 50))
41:
42: (defconst x-button-c-s-right (char-to-string 80))
43: (defconst x-button-c-s-middle (char-to-string 81))
44: (defconst x-button-c-s-left (char-to-string 82))
45:
46: (defconst x-button-c-m-right (char-to-string 96))
47: (defconst x-button-c-m-middle (char-to-string 97))
48: (defconst x-button-c-m-left (char-to-string 98))
49:
50: (defconst x-button-c-m-s-right (char-to-string 112))
51: (defconst x-button-c-m-s-middle (char-to-string 113))
52: (defconst x-button-c-m-s-left (char-to-string 114))
53:
54: (defun x-flush-mouse-queue ()
55: "Process all queued mouse events."
56: ;; A mouse event causes a special character sequence to be given
57: ;; as keyboard input. That runs this function, which process all
58: ;; queued mouse events and returns.
59: (interactive)
60: (while (> (x-mouse-events) 0)
61: (x-proc-mouse-event)))
62:
63: (define-key global-map "\C-c\C-m" 'x-flush-mouse-queue)
64:
65: (defun x-mouse-select (arg)
66: "Select Emacs window the mouse is on."
67: (let ((start-w (selected-window))
68: (done nil)
69: (w (selected-window))
70: (rel-coordinate nil))
71: (while (and (not done)
72: (null (setq rel-coordinate
73: (coordinates-in-window-p arg w))))
74: (setq w (next-window w))
75: (if (eq w start-w)
76: (setq done t)))
77: (select-window w)
78: rel-coordinate))
79:
80: (defun x-mouse-keep-one-window (arg)
81: "Select Emacs window mouse is on, then kill all other Emacs windows."
82: (if (x-mouse-select arg)
83: (delete-other-windows)))
84:
85: (defun x-mouse-select-and-split (arg)
86: "Select Emacs window mouse is on, then split it vertically in half."
87: (if (x-mouse-select arg)
88: (split-window-vertically nil)))
89:
90: (defun x-mouse-set-point (arg)
91: "Select Emacs window mouse is on, and move point to mouse position."
92: (let* ((relative-coordinate (x-mouse-select arg))
93: (rel-x (car relative-coordinate))
94: (rel-y (car (cdr relative-coordinate))))
95: (if relative-coordinate
96: (progn
97: (move-to-window-line rel-y)
98: (move-to-column (+ rel-x (current-column)))))))
99:
100: (defun x-mouse-set-mark (arg)
101: "Select Emacs window mouse is on, and set mark at mouse position.
102: Display cursor at that position for a second."
103: (if (x-mouse-select arg)
104: (let ((point-save (point)))
105: (unwind-protect
106: (progn (x-mouse-set-point arg)
107: (set-mark (point))
108: (sit-for 1))
109: (goto-char point-save)))))
110:
111: (defun x-cut-text (arg &optional kill)
112: "Copy text between point and mouse position into window system cut buffer.
113: Save in Emacs kill ring also."
114: (if (coordinates-in-window-p arg (selected-window))
115: (save-excursion
116: (let ((opoint (point))
117: beg end)
118: (x-mouse-set-point arg)
119: (setq beg (min opoint (point))
120: end (max opoint (point)))
121: (x-store-cut-buffer (buffer-substring beg end))
122: (copy-region-as-kill beg end)
123: (if kill (delete-region beg end))))
124: (message "Mouse not in selected window")))
125:
126: (defun x-paste-text (arg)
127: "Move point to mouse position and insert window system cut buffer contents."
128: (x-mouse-set-point arg)
129: (insert (x-get-cut-buffer)))
130:
131: (defun x-cut-and-wipe-text (arg)
132: "Kill text between point and mouse; also copy to window system cut buffer."
133: (x-cut-text arg t))
134:
135: (define-key mouse-map x-button-right 'x-mouse-select)
136: (define-key mouse-map x-button-left 'x-mouse-set-mark)
137: (define-key mouse-map x-button-c-s-right 'x-mouse-keep-one-window)
138: (define-key mouse-map x-button-c-right 'x-mouse-select-and-split)
139: (define-key mouse-map x-button-middle 'x-mouse-set-point)
140: (define-key mouse-map x-button-s-middle 'x-cut-text)
141: (define-key mouse-map x-button-s-right 'x-paste-text)
142: (define-key mouse-map x-button-c-middle 'x-cut-and-wipe-text)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.