1 ;;; bg-mouse.el --- GNU Emacs code for BBN Bitgraph mouse
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
4 ;; 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: John Robinson <jr@bbn-unix.arpa>
7 ;; Stephen Gildea <gildea@bbn.com>
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
30 ;; This file has been obsolete since Emacs 22.1.
34 ;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985
35 ;;; Modularized and enhanced by gildea@bbn.com Nov 1987
36 ;;; Time stamp <89/03/21 14:27:08 gildea>
38 ;;; User customization option:
40 (defvar bg-mouse-fast-select-window nil
41 "*Non-nil for mouse hits to select new window, then execute; else just select.")
43 ;;; These numbers are summed to make the index into the mouse-map.
44 ;;; The low three bits correspond to what the mouse actually sends.
45 (defconst bg-button-r
1)
46 (defconst bg-button-m
2)
47 (defconst bg-button-c
2)
48 (defconst bg-button-l
4)
49 (defconst bg-in-modeline
8)
50 (defconst bg-in-scrollbar
16)
51 (defconst bg-in-minibuf
24)
53 ;;; semicolon screws up indenting, so use this instead
54 (defconst semicolon ?\
;)
58 (defvar bg-cursor-window
)
59 ;; This variable does not exist since 1991, so it's a safe bet
60 ;; this package is not really used anymore. Still...
65 (defun bg-mouse-report (prefix-arg)
66 "Read, parse, and execute a BBN BitGraph mouse click.
68 L-- move point | These apply for mouse click in a window.
69 --R set mark | If bg-mouse-fast-select-window is nil,
70 L-R kill region | these commands on a nonselected window
71 -C- move point and yank | just select that window.
73 -CR or LCR undo | \"Scroll bar\" is right-hand window column.
75 on modeline: on \"scroll bar\": in minibuffer:
76 L-- scroll-up line to top execute-extended-command
77 --R scroll-down line to bottom eval-expression
78 -C- proportional goto-char line to middle suspend-emacs
80 To reinitialize the mouse if the terminal is reset, type ESC : RET"
82 (bg-get-tty-num semicolon
)
84 ((screen-mouse-x (min (1- (frame-width)) ;don't hit column 86!
85 (/ (bg-get-tty-num semicolon
) 9)))
86 (screen-mouse-y (- (1- (frame-height)) ;assume default font size.
87 (/ (bg-get-tty-num semicolon
) 16)))
88 (bg-mouse-buttons (%
(bg-get-tty-num ?c
) 8))
89 (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y
))
90 (bg-cursor-window (selected-window))
91 (edges (window-edges bg-mouse-window
))
92 (minibuf-p (= screen-mouse-y
(1- (frame-height))))
93 (in-modeline-p (and (not minibuf-p
)
94 (= screen-mouse-y
(1- (nth 3 edges
)))))
95 (in-scrollbar-p (and (not minibuf-p
) (not in-modeline-p
)
96 (>= screen-mouse-x
(1- (nth 2 edges
)))))
97 (same-window-p (eq bg-mouse-window bg-cursor-window
))
98 (in-minibuf-p (and minibuf-p
99 (not bg-mouse-window
))) ;minibuf must be inactive
100 (bg-mode-bits (+ (if in-minibuf-p bg-in-minibuf
0)
101 (if in-modeline-p bg-in-modeline
0)
102 (if in-scrollbar-p bg-in-scrollbar
0)))
104 (lookup-key mouse-map
105 (char-to-string (+ bg-mode-bits bg-mouse-buttons
))))
106 (bg-mouse-x (- screen-mouse-x
(nth 0 edges
)))
107 (bg-mouse-y (- screen-mouse-y
(nth 1 edges
))))
108 (cond ((or in-modeline-p in-scrollbar-p
)
109 (select-window bg-mouse-window
)
110 (bg-command-execute bg-command
)
111 (select-window bg-cursor-window
))
112 ((or same-window-p in-minibuf-p
)
113 (bg-command-execute bg-command
))
114 (t ;in another window
115 (select-window bg-mouse-window
)
116 (if bg-mouse-fast-select-window
117 (bg-command-execute bg-command
)))
121 ;;; Library of commands:
123 (defun bg-set-point ()
124 "Move point to location of BitGraph mouse."
126 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y
)
127 (setq this-command
'next-line
) ;make subsequent line moves work
128 (setq temporary-goal-column bg-mouse-x
))
130 (defun bg-set-mark ()
131 "Set mark at location of BitGraph mouse."
134 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y
)
135 (exchange-point-and-mark))
138 "Move point to location of BitGraph mouse and yank."
140 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y
)
141 (setq this-command
'yank
)
148 (defun bg-yank-or-pop ()
149 "Move point to location of BitGraph mouse and yank. If last command
150 was a yank, do a yank-pop."
152 (if (eq last-command
'yank
)
156 ;;; In 18.51, Emacs Lisp doesn't provide most-positive-fixnum
157 (defconst bg-most-positive-fixnum
8388607)
159 (defun bg-move-by-percentage ()
160 "Go to location in buffer that is the same percentage of the way
161 through the buffer as the BitGraph mouse's X position in the window."
163 ;; check carefully for overflow in intermediate calculations
165 (cond ((zerop bg-mouse-x
)
167 ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x
))
168 ;; no danger of overflow: compute it exactly
169 (/ (* bg-mouse-x
(buffer-size))
170 (1- (window-width))))
172 ;; overflow possible: approximate
173 (* (/ (buffer-size) (1- (window-width)))
176 (what-cursor-position))
178 (defun bg-mouse-line-to-top ()
179 "Scroll the line pointed to by the BitGraph mouse to the top of the window."
181 (scroll-up bg-mouse-y
))
183 (defun bg-mouse-line-to-center ()
184 "Scroll the line pointed to by the BitGraph mouse to the center
187 (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y
(- (window-height))) 2)))
189 (defun bg-mouse-line-to-bottom ()
190 "Scroll the line pointed to by the mouse to the bottom of the window."
192 (scroll-up (+ bg-mouse-y
(- 2 (window-height)))))
194 (defun bg-kill-region ()
196 (kill-region (region-beginning) (region-end)))
198 (defun bg-insert-moused-sexp ()
199 "Insert a copy of the word (actually sexp) that the mouse is pointing at.
200 Sexp is inserted into the buffer at point (where the text cursor is)."
204 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y
)
205 (if (looking-at "\\s)")
208 (buffer-substring (save-excursion (backward-sexp 1) (point))
210 (select-window bg-cursor-window
)
211 (delete-horizontal-space)
214 (indent-according-to-mode))
215 ;; In Lisp assume double-quote is closing; in Text assume opening.
216 ;; Why? Because it does the right thing most often.
217 ((save-excursion (forward-char -
1)
218 (and (not (looking-at "\\s\""))
219 (looking-at "[`'\"\\]\\|\\s(")))
225 (looking-at "\\s.\\|\\s)")
226 (and (looking-at "'") (looking-at "\\sw")) ;hack for text mode
227 (save-excursion (insert " ")))))
229 ;;; Utility functions:
231 (defun bg-get-tty-num (term-char)
232 "Read from terminal until TERM-CHAR is read, and return intervening number.
233 If non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error."
236 (char (- (read-char) 48)))
237 (while (and (>= char
0)
239 (setq num
(+ (* num
10) char
))
240 (setq char
(- (read-char) 48)))
241 (or (eq term-char
(+ char
48))
245 "Invalid data format in bg-mouse command: mouse reinitialized.")))
248 ;;; Note that this fails in the minibuf because move-to-column doesn't
249 ;;; allow for the width of the prompt.
250 (defun bg-move-point-to-x-y (x y
)
251 "Position cursor in window coordinates.
252 X and Y are 0-based character positions in the window."
253 (move-to-window-line y
)
254 ;; if not on a wrapped line, zero-column will be 0
255 (let ((zero-column (current-column))
256 (scroll-offset (window-hscroll)))
257 ;; scrolling takes up column 0 to display the $
258 (if (> scroll-offset
0)
259 (setq scroll-offset
(1- scroll-offset
)))
260 (move-to-column (+ zero-column scroll-offset x
))
263 ;;; Returns the window that screen position (x, y) is in or nil if none,
264 ;;; meaning we are in the echo area with a non-active minibuffer.
265 (defun bg-window-from-x-y (x y
)
266 "Find window corresponding to screen coordinates.
267 X and Y are 0-based character positions on the screen."
268 (get-window-with-predicate (lambda (w)
269 (coordinates-in-window-p (cons x y
) w
))))
271 (defun bg-command-execute (bg-command)
272 (if (commandp bg-command
)
273 (command-execute bg-command
)
276 (defun bg-program-mouse ()
277 (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c"))
279 ;;; Note that the doc string for mouse-map (as defined in subr.el)
280 ;;; says it is for the X-window mouse. This is wrong; that keymap
281 ;;; should be used for your mouse no matter what terminal you have.
283 (or (keymapp mouse-map
)
284 (setq mouse-map
(make-keymap)))
286 (defun bind-bg-mouse-click (click-code function
)
287 "Bind bg-mouse CLICK-CODE to run FUNCTION."
288 (define-key mouse-map
(char-to-string click-code
) function
))
290 (bind-bg-mouse-click bg-button-l
'bg-set-point
)
291 (bind-bg-mouse-click bg-button-m
'bg-yank
)
292 (bind-bg-mouse-click bg-button-r
'bg-set-mark
)
293 (bind-bg-mouse-click (+ bg-button-l bg-button-m
) 'yank-pop-1
)
294 (bind-bg-mouse-click (+ bg-button-l bg-button-r
) 'bg-kill-region
)
295 (bind-bg-mouse-click (+ bg-button-m bg-button-r
) 'undo
)
296 (bind-bg-mouse-click (+ bg-button-l bg-button-m bg-button-r
) 'undo
)
297 (bind-bg-mouse-click (+ bg-in-modeline bg-button-l
) 'scroll-up
)
298 (bind-bg-mouse-click (+ bg-in-modeline bg-button-m
) 'bg-move-by-percentage
)
299 (bind-bg-mouse-click (+ bg-in-modeline bg-button-r
) 'scroll-down
)
300 (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-l
) 'bg-mouse-line-to-top
)
301 (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-m
) 'bg-mouse-line-to-center
)
302 (bind-bg-mouse-click (+ bg-in-scrollbar bg-button-r
) 'bg-mouse-line-to-bottom
)
303 (bind-bg-mouse-click (+ bg-in-minibuf bg-button-l
) 'execute-extended-command
)
304 (bind-bg-mouse-click (+ bg-in-minibuf bg-button-m
) 'suspend-emacs
)
305 (bind-bg-mouse-click (+ bg-in-minibuf bg-button-r
) 'eval-expression
)
309 ;; arch-tag: b3d06605-2971-44b1-be2c-e49c24e1a8d3
310 ;;; bg-mouse.el ends here