1 ;;; sup-mouse.el --- supdup mouse support for lisp machines
3 ;; Copyright (C) Free Software Foundation 1985, 1986
5 ;; Author: Wolfgang Rupprecht
7 ;; Created: 21 Nov 1986
10 ;; (from code originally written by John Robinson@bbn for the bitgraph)
12 ;; This file is part of SXEmacs.
14 ;; SXEmacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; SXEmacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
29 (globally-declare-fboundp 'window-edges))
31 ;;; User customization option:
33 (defvar sup-mouse-fast-select-window nil
34 "*Non-nil for mouse hits to select new window, then execute; else just select.")
36 (defconst mouse-left 0)
37 (defconst mouse-center 1)
38 (defconst mouse-right 2)
40 (defconst mouse-2left 4)
41 (defconst mouse-2center 5)
42 (defconst mouse-2right 6)
44 (defconst mouse-3left 8)
45 (defconst mouse-3center 9)
46 (defconst mouse-3right 10)
50 (defun sup-mouse-report ()
51 "This function is called directly by the mouse, it parses and
52 executes the mouse commands.
54 L move point * |---- These apply for mouse click in a window.
56 3L copy word | If sup-mouse-fast-select-window is nil,
57 C move point and yank * | just selects that window.
63 on modeline on \"scroll bar\" in minibuffer
64 L scroll-up line to top execute-extended-command
65 C proportional goto-char line to middle mouse-help
66 R scroll-down line to bottom eval-expression"
70 ;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
71 ((buttons (sup-get-tty-num ?\;))
72 (x (sup-get-tty-num ?\;))
73 (y (sup-get-tty-num ?c))
74 (window (sup-pos-to-window x y))
75 (edges (window-edges window))
76 (old-window (selected-window))
77 (in-minibuf-p (eq y (1- (frame-height))))
78 (same-window-p (and (not in-minibuf-p) (eq window old-window)))
79 (in-modeline-p (eq y (1- (nth 3 edges))))
80 (in-scrollbar-p (>= x (1- (nth 2 edges)))))
81 (setq x (- x (nth 0 edges)))
82 (setq y (- y (nth 1 edges)))
84 ; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
87 (select-window window)
88 (cond ((= buttons mouse-left)
90 ((= buttons mouse-right)
92 ((= buttons mouse-center)
94 (- (point-max) (point-min)))
97 (what-cursor-position)))
98 (select-window old-window))
100 (select-window window)
102 (cond ((= buttons mouse-left)
104 ((= buttons mouse-right)
105 (+ y (- 2 (window-height))))
106 ((= buttons mouse-center)
107 (/ (+ 2 y y (- (window-height))) 2))
110 (select-window old-window))
112 (cond ((= buttons mouse-left)
113 (sup-move-point-to-x-y x y))
114 ((= buttons mouse-2left)
115 (sup-move-point-to-x-y x y)
117 ((= buttons mouse-3left)
118 (sup-move-point-to-x-y x y)
121 (point) (progn (forward-word 1) (point))))
122 (setq this-command 'yank)
124 ((= buttons mouse-right)
126 (sup-move-point-to-x-y x y)
127 (exchange-point-and-mark))
128 ((= buttons mouse-2right)
130 (sup-move-point-to-x-y x y)
131 (kill-region (mark) (point)))
132 ((= buttons mouse-3right)
134 (sup-move-point-to-x-y x y)
135 (copy-region-as-kill (mark) (point))
136 (setq this-command 'yank))
137 ((= buttons mouse-center)
138 (sup-move-point-to-x-y x y)
139 (setq this-command 'yank)
141 ((= buttons mouse-2center)
146 (cond ((= buttons mouse-right)
147 (call-interactively 'eval-expression))
148 ((= buttons mouse-left)
149 (call-interactively 'execute-extended-command))
150 ((= buttons mouse-center)
151 (describe-function 'sup-mouse-report)); silly self help
153 (t ;in another window
154 (select-window window)
155 (cond ((not sup-mouse-fast-select-window))
156 ((= buttons mouse-left)
157 (sup-move-point-to-x-y x y))
158 ((= buttons mouse-right)
160 (sup-move-point-to-x-y x y)
161 (exchange-point-and-mark))
162 ((= buttons mouse-center)
163 (sup-move-point-to-x-y x y)
164 (setq this-command 'yank)
170 (defun sup-get-tty-num (term-char)
171 "Read from terminal until TERM-CHAR is read, and return intervening number.
172 Upon non-numeric not matching TERM-CHAR signal an error."
176 (while (and (>= char ?0)
178 (setq num (+ (* num 10) (- char ?0)))
179 (setq char (read-char)))
180 (or (eq term-char char)
181 (error "Invalid data format in mouse command"))
184 (defun sup-move-point-to-x-y (x y)
185 "Position cursor in window coordinates.
186 X and Y are 0-based character positions in the window."
187 (move-to-window-line y)
191 (defun sup-pos-to-window (x y)
192 "Find window corresponding to frame coordinates.
193 X and Y are 0-based character positions on the frame."
194 (let ((edges (window-edges))
196 (while (and (not (eq window (selected-window)))
197 (or (< y (nth 1 edges))
200 (>= x (nth 2 edges))))
201 (setq window (next-window window))
202 (setq edges (window-edges window))
204 (or window (selected-window))
208 ;;; sup-mouse.el ends here