1 ;;; sup-mouse.el --- supdup mouse support for lisp machines
3 ;; Copyright (C) 1985-1986, 2001-2016 Free Software Foundation, Inc.
5 ;; Author: Wolfgang Rupprecht
6 ;; Maintainer: emacs-devel@gnu.org
7 ;; Created: 21 Nov 1986
9 ;; Obsolete-since: 24.4
11 ;; (from code originally written by John Robinson@bbn for the bitgraph)
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
32 ;;; User customization option:
34 (defcustom sup-mouse-fast-select-window nil
35 "Non-nil means mouse hits select new window, then execute.
36 Otherwise just select."
40 (defconst mouse-left
0)
41 (defconst mouse-center
1)
42 (defconst mouse-right
2)
44 (defconst mouse-2left
4)
45 (defconst mouse-2center
5)
46 (defconst mouse-2right
6)
48 (defconst mouse-3left
8)
49 (defconst mouse-3center
9)
50 (defconst mouse-3right
10)
54 (defun sup-mouse-report ()
55 "This function is called directly by the mouse, it parses and
56 executes the mouse commands.
58 L move point * |---- These apply for mouse click in a window.
60 3L copy word | If sup-mouse-fast-select-window is nil,
61 C move point and yank * | just selects that window.
67 on mode line on \"scroll bar\" in minibuffer
68 L scroll-up line to top execute-extended-command
69 C proportional goto-char line to middle mouse-help
70 R scroll-down line to bottom eval-expression"
74 ;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
75 ((buttons (sup-get-tty-num ?\
;))
76 (x (sup-get-tty-num ?\
;))
77 (y (sup-get-tty-num ?c
))
78 (window (sup-pos-to-window x y
))
79 (edges (window-edges window
))
80 (old-window (selected-window))
81 (in-minibuf-p (eq y
(1- (frame-height))))
82 (same-window-p (and (not in-minibuf-p
) (eq window old-window
)))
83 (in-mode-line-p (eq y
(1- (nth 3 edges
))))
84 (in-scrollbar-p (>= x
(1- (nth 2 edges
)))))
85 (setq x
(- x
(nth 0 edges
)))
86 (setq y
(- y
(nth 1 edges
)))
88 ; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
91 (select-window window
)
92 (cond ((= buttons mouse-left
)
94 ((= buttons mouse-right
)
96 ((= buttons mouse-center
)
98 (- (point-max) (point-min)))
101 (what-cursor-position)))
102 (select-window old-window
))
104 (select-window window
)
106 (cond ((= buttons mouse-left
)
108 ((= buttons mouse-right
)
109 (+ y
(- 2 (window-height))))
110 ((= buttons mouse-center
)
111 (/ (+ 2 y y
(- (window-height))) 2))
114 (select-window old-window
))
116 (cond ((= buttons mouse-left
)
117 (sup-move-point-to-x-y x y
))
118 ((= buttons mouse-2left
)
119 (sup-move-point-to-x-y x y
)
121 ((= buttons mouse-3left
)
122 (sup-move-point-to-x-y x y
)
125 (point) (progn (forward-word 1) (point))))
126 (setq this-command
'yank
)
128 ((= buttons mouse-right
)
130 (sup-move-point-to-x-y x y
)
131 (exchange-point-and-mark))
132 ((= buttons mouse-2right
)
134 (sup-move-point-to-x-y x y
)
135 (kill-region (mark) (point)))
136 ((= buttons mouse-3right
)
138 (sup-move-point-to-x-y x y
)
139 (copy-region-as-kill (mark) (point))
140 (setq this-command
'yank
))
141 ((= buttons mouse-center
)
142 (sup-move-point-to-x-y x y
)
143 (setq this-command
'yank
)
145 ((= buttons mouse-2center
)
150 (cond ((= buttons mouse-right
)
151 (call-interactively 'eval-expression
))
152 ((= buttons mouse-left
)
153 (call-interactively 'execute-extended-command
))
154 ((= buttons mouse-center
)
155 (describe-function 'sup-mouse-report
)); silly self help
157 (t ;in another window
158 (select-window window
)
159 (cond ((not sup-mouse-fast-select-window
))
160 ((= buttons mouse-left
)
161 (sup-move-point-to-x-y x y
))
162 ((= buttons mouse-right
)
164 (sup-move-point-to-x-y x y
)
165 (exchange-point-and-mark))
166 ((= buttons mouse-center
)
167 (sup-move-point-to-x-y x y
)
168 (setq this-command
'yank
)
174 (defun sup-get-tty-num (term-char)
175 "Read from terminal until TERM-CHAR is read, and return intervening number.
176 Upon non-numeric not matching TERM-CHAR signal an error."
180 (while (and (>= char ?
0)
182 (setq num
(+ (* num
10) (- char ?
0)))
183 (setq char
(read-char)))
184 (or (eq term-char char
)
185 (error "Invalid data format in mouse command"))
188 (defun sup-move-point-to-x-y (x y
)
189 "Position cursor in window coordinates.
190 X and Y are 0-based character positions in the window."
191 (move-to-window-line y
)
195 (defun sup-pos-to-window (x y
)
196 "Find window corresponding to frame coordinates.
197 X and Y are 0-based character positions on the frame."
198 (get-window-with-predicate (lambda (w)
199 (coordinates-in-window-p (cons x y
) w
))))
203 ;;; sup-mouse.el ends here