(adjust_before_replace): Comment added.
[bpt/emacs.git] / lisp / term / bg-mouse.el
CommitLineData
c0274f38
ER
1;;; bg-mouse.el --- GNU Emacs code for BBN Bitgraph mouse.
2
9750e079
ER
3;; Copyright (C) Free Software Foundation, Inc. Oct 1985.
4
e5167999
ER
5;; Author: John Robinson <jr@bbn-unix.arpa>
6;; Stephen Gildea <gildea@bbn.com>
7;; Maintainer: FSF
e5167999
ER
8;; Keywords: hardware
9
54369c0f
JB
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
e5167999 14;; the Free Software Foundation; either version 2, or (at your option)
54369c0f
JB
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
2fe590dc
EN
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
54369c0f 26
e5167999 27;;; Code:
54369c0f
JB
28
29;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985
30;;; Modularized and enhanced by gildea@bbn.com Nov 1987
e5167999 31;;; Time stamp <89/03/21 14:27:08 gildea>
54369c0f 32
54369c0f
JB
33;;; User customization option:
34
35(defvar bg-mouse-fast-select-window nil
36 "*Non-nil for mouse hits to select new window, then execute; else just select.")
37
38;;; These numbers are summed to make the index into the mouse-map.
39;;; The low three bits correspond to what the mouse actually sends.
40(defconst bg-button-r 1)
41(defconst bg-button-m 2)
42(defconst bg-button-c 2)
43(defconst bg-button-l 4)
44(defconst bg-in-modeline 8)
45(defconst bg-in-scrollbar 16)
46(defconst bg-in-minibuf 24)
47
48;;; semicolon screws up indenting, so use this instead
49(defconst semicolon ?\;)
50
51;;; Defuns:
52
53(defun bg-mouse-report (prefix-arg)
54 "Read, parse, and execute a BBN BitGraph mouse click.
55
56L-- move point | These apply for mouse click in a window.
57--R set mark | If bg-mouse-fast-select-window is nil,
58L-R kill region | these commands on a nonselected window
59-C- move point and yank | just select that window.
60LC- yank-pop |
61-CR or LCR undo | \"Scroll bar\" is right-hand window column.
62
63on modeline: on \"scroll bar\": in minibuffer:
64L-- scroll-up line to top execute-extended-command
65--R scroll-down line to bottom eval-expression
66-C- proportional goto-char line to middle suspend-emacs
67
68To reinitialize the mouse if the terminal is reset, type ESC : RET"
69 (interactive "P")
70 (bg-get-tty-num semicolon)
71 (let*
e5167999 72 ((screen-mouse-x (min (1- (frame-width)) ;don't hit column 86!
54369c0f 73 (/ (bg-get-tty-num semicolon) 9)))
e5167999 74 (screen-mouse-y (- (1- (frame-height)) ;assume default font size.
54369c0f
JB
75 (/ (bg-get-tty-num semicolon) 16)))
76 (bg-mouse-buttons (% (bg-get-tty-num ?c) 8))
77 (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y))
78 (bg-cursor-window (selected-window))
79 (edges (window-edges bg-mouse-window))
80 (minibuf-p (= screen-mouse-y (1- (screen-height))))
81 (in-modeline-p (and (not minibuf-p)
82 (= screen-mouse-y (1- (nth 3 edges)))))
83 (in-scrollbar-p (and (not minibuf-p) (not in-modeline-p)
84 (>= screen-mouse-x (1- (nth 2 edges)))))
85 (same-window-p (eq bg-mouse-window bg-cursor-window))
86 (in-minibuf-p (and minibuf-p
87 (not bg-mouse-window))) ;minibuf must be inactive
88 (bg-mode-bits (+ (if in-minibuf-p bg-in-minibuf 0)
89 (if in-modeline-p bg-in-modeline 0)
90 (if in-scrollbar-p bg-in-scrollbar 0)))
91 (bg-command
92 (lookup-key mouse-map
93 (char-to-string (+ bg-mode-bits bg-mouse-buttons))))
94 (bg-mouse-x (- screen-mouse-x (nth 0 edges)))
95 (bg-mouse-y (- screen-mouse-y (nth 1 edges))))
96 (cond ((or in-modeline-p in-scrollbar-p)
97 (select-window bg-mouse-window)
98 (bg-command-execute bg-command)
99 (select-window bg-cursor-window))
100 ((or same-window-p in-minibuf-p)
101 (bg-command-execute bg-command))
102 (t ;in another window
103 (select-window bg-mouse-window)
104 (if bg-mouse-fast-select-window
105 (bg-command-execute bg-command)))
106 )))
107
108\f
109;;; Library of commands:
110
111(defun bg-set-point ()
112 "Move point to location of BitGraph mouse."
113 (interactive)
114 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
115 (setq this-command 'next-line) ;make subsequent line moves work
116 (setq temporary-goal-column bg-mouse-x))
117
118(defun bg-set-mark ()
119 "Set mark at location of BitGraph mouse."
120 (interactive)
121 (push-mark)
122 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
123 (exchange-point-and-mark))
124
125(defun bg-yank ()
126 "Move point to location of BitGraph mouse and yank."
127 (interactive "*")
128 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
129 (setq this-command 'yank)
130 (yank))
131
132(defun yank-pop-1 ()
133 (interactive "*")
134 (yank-pop 1))
135
136(defun bg-yank-or-pop ()
137 "Move point to location of BitGraph mouse and yank. If last command
138was a yank, do a yank-pop."
139 (interactive "*")
fc4c0f0e 140 (if (eq last-command 'yank)
54369c0f
JB
141 (yank-pop 1)
142 (bg-yank)))
143
144;;; In 18.51, Emacs Lisp doesn't provide most-positive-fixnum
145(defconst bg-most-positive-fixnum 8388607)
146
147(defun bg-move-by-percentage ()
148 "Go to location in buffer that is the same percentage of the way
149through the buffer as the BitGraph mouse's X position in the window."
150 (interactive)
151 ;; check carefully for overflow in intermediate calculations
152 (goto-char
153 (cond ((zerop bg-mouse-x)
154 0)
155 ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x))
156 ;; no danger of overflow: compute it exactly
157 (/ (* bg-mouse-x (buffer-size))
158 (1- (window-width))))
159 (t
160 ;; overflow possible: approximate
161 (* (/ (buffer-size) (1- (window-width)))
162 bg-mouse-x))))
163 (beginning-of-line)
164 (what-cursor-position))
165
166(defun bg-mouse-line-to-top ()
167 "Scroll the line pointed to by the BitGraph mouse to the top of the window."
168 (interactive)
169 (scroll-up bg-mouse-y))
170
171(defun bg-mouse-line-to-center ()
172 "Scroll the line pointed to by the BitGraph mouse to the center
173of the window"
174 (interactive)
175 (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y (- (window-height))) 2)))
176
177(defun bg-mouse-line-to-bottom ()
178 "Scroll the line pointed to by the mouse to the bottom of the window."
179 (interactive)
180 (scroll-up (+ bg-mouse-y (- 2 (window-height)))))
181
182(defun bg-kill-region ()
183 (interactive "*")
184 (kill-region (region-beginning) (region-end)))
185
186(defun bg-insert-moused-sexp ()
187 "Insert a copy of the word (actually sexp) that the mouse is pointing at.
188Sexp is inserted into the buffer at point (where the text cursor is)."
189 (interactive)
190 (let ((moused-text
191 (save-excursion
192 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
193 (if (looking-at "\\s)")
194 (forward-char 1)
195 (forward-sexp 1))
196 (buffer-substring (save-excursion (backward-sexp 1) (point))
197 (point)))))
198 (select-window bg-cursor-window)
199 (delete-horizontal-space)
200 (cond
201 ((bolp)
202 (indent-according-to-mode))
203 ;; In Lisp assume double-quote is closing; in Text assume opening.
204 ;; Why? Because it does the right thing most often.
205 ((save-excursion (forward-char -1)
206 (and (not (looking-at "\\s\""))
207 (looking-at "[`'\"\\]\\|\\s(")))
208 nil)
209 (t
210 (insert-string " ")))
211 (insert-string moused-text)
212 (or (eolp)
213 (looking-at "\\s.\\|\\s)")
214 (and (looking-at "'") (looking-at "\\sw")) ;hack for text mode
215 (save-excursion (insert-string " ")))))
216\f
217;;; Utility functions:
218
219(defun bg-get-tty-num (term-char)
220 "Read from terminal until TERM-CHAR is read, and return intervening number.
221If non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error."
222 (let
223 ((num 0)
224 (char (- (read-char) 48)))
225 (while (and (>= char 0)
226 (<= char 9))
227 (setq num (+ (* num 10) char))
228 (setq char (- (read-char) 48)))
229 (or (eq term-char (+ char 48))
230 (progn
231 (bg-program-mouse)
232 (error
233 "Invalid data format in bg-mouse command: mouse reinitialized.")))
234 num))
235
236;;; Note that this fails in the minibuf because move-to-column doesn't
237;;; allow for the width of the prompt.
238(defun bg-move-point-to-x-y (x y)
239 "Position cursor in window coordinates.
240X and Y are 0-based character positions in the window."
241 (move-to-window-line y)
242 ;; if not on a wrapped line, zero-column will be 0
243 (let ((zero-column (current-column))
244 (scroll-offset (window-hscroll)))
245 ;; scrolling takes up column 0 to display the $
246 (if (> scroll-offset 0)
247 (setq scroll-offset (1- scroll-offset)))
248 (move-to-column (+ zero-column scroll-offset x))
249 ))
250
251;;; Returns the window that screen position (x, y) is in or nil if none,
252;;; meaning we are in the echo area with a non-active minibuffer.
253;;; If coordinates-in-window-p were not in an X-windows-specific file
254;;; we could use that. In Emacs 19 can even use locate-window-from-coordinates
255(defun bg-window-from-x-y (x y)
256 "Find window corresponding to screen coordinates.
257X and Y are 0-based character positions on the screen."
258 (let ((edges (window-edges))
259 (window nil))
260 (while (and (not (eq window (selected-window)))
261 (or (< y (nth 1 edges))
262 (>= y (nth 3 edges))
263 (< x (nth 0 edges))
264 (>= x (nth 2 edges))))
265 (setq window (next-window window))
266 (setq edges (window-edges window)))
267 (cond ((eq window (selected-window))
268 nil) ;we've looped: not found
269 ((not window)
270 (selected-window)) ;just starting: current window
271 (t
272 window))
273 ))
274
275(defun bg-command-execute (bg-command)
276 (if (commandp bg-command)
277 (command-execute bg-command)
278 (ding)))
279
280(defun bg-program-mouse ()
281 (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c"))
282
283;;; Note that the doc string for mouse-map (as defined in subr.el)
284;;; says it is for the X-window mouse. This is wrong; that keymap
285;;; should be used for your mouse no matter what terminal you have.
286
287(or (keymapp mouse-map)
288 (setq mouse-map (make-keymap)))
289
290(defun bind-bg-mouse-click (click-code function)
291 "Bind bg-mouse CLICK-CODE to run FUNCTION."
292 (define-key mouse-map (char-to-string click-code) function))
293
294(bind-bg-mouse-click bg-button-l 'bg-set-point)
295(bind-bg-mouse-click bg-button-m 'bg-yank)
296(bind-bg-mouse-click bg-button-r 'bg-set-mark)
297(bind-bg-mouse-click (+ bg-button-l bg-button-m) 'yank-pop-1)
298(bind-bg-mouse-click (+ bg-button-l bg-button-r) 'bg-kill-region)
299(bind-bg-mouse-click (+ bg-button-m bg-button-r) 'undo)
300(bind-bg-mouse-click (+ bg-button-l bg-button-m bg-button-r) 'undo)
301(bind-bg-mouse-click (+ bg-in-modeline bg-button-l) 'scroll-up)
302(bind-bg-mouse-click (+ bg-in-modeline bg-button-m) 'bg-move-by-percentage)
303(bind-bg-mouse-click (+ bg-in-modeline bg-button-r) 'scroll-down)
304(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-l) 'bg-mouse-line-to-top)
305(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-m) 'bg-mouse-line-to-center)
306(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-r) 'bg-mouse-line-to-bottom)
307(bind-bg-mouse-click (+ bg-in-minibuf bg-button-l) 'execute-extended-command)
308(bind-bg-mouse-click (+ bg-in-minibuf bg-button-m) 'suspend-emacs)
309(bind-bg-mouse-click (+ bg-in-minibuf bg-button-r) 'eval-expression)
310
49116ac0
JB
311(provide 'bg-mouse)
312
c0274f38 313;;; bg-mouse.el ends here