Mercurial > hg > xemacs-beta

comparison lisp/term/bg-mouse.el @ 772:d682c0f82a71

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 10:00:06 by ben] a few bytecomp warning fixes, run autoconf just in case
author ben
date Wed, 13 Mar 2002 10:00:09 +0000
parents 1ccc32a20af4
children 85bd42a1e544 308d34e9f07d
comparison
equal deleted inserted replaced
771:943eaba38521 772:d682c0f82a71
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to 23 ;; along with GNU Emacs; see the file COPYING. If not, write to
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25 25
26 ;;; Code: 26 ;;; Code:
27
28 ;;; #### utterly broken. I've put in hacks so we don't get byte-comp
29 ;;; warnings, but this shit should go NOW. --ben
27 30
28 ;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985 31 ;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985
29 ;;; Modularized and enhanced by gildea@bbn.com Nov 1987 32 ;;; Modularized and enhanced by gildea@bbn.com Nov 1987
30 ;;; Time stamp <89/03/21 14:27:08 gildea> 33 ;;; Time stamp <89/03/21 14:27:08 gildea>
31 34
47 ;;; semicolon screws up indenting, so use this instead 50 ;;; semicolon screws up indenting, so use this instead
48 (defconst semicolon ?\;) 51 (defconst semicolon ?\;)
49 52
50 ;;; Defuns: 53 ;;; Defuns:
51 54
55 ;; #### bunch of crap.
56 (globally-declare-boundp 'mouse-map)
57
58 (defun bg-window-edges (&optional win)
59 (error "not implemented")
60 (window-pixel-edges win))
61
52 (defun bg-mouse-report (prefix-arg) 62 (defun bg-mouse-report (prefix-arg)
53 "Read, parse, and execute a BBN BitGraph mouse click. 63 "Read, parse, and execute a BBN BitGraph mouse click.
54 64
55 L-- move point | These apply for mouse click in a window. 65 L-- move point | These apply for mouse click in a window.
56 --R set mark | If bg-mouse-fast-select-window is nil, 66 --R set mark | If bg-mouse-fast-select-window is nil,
64 --R scroll-down line to bottom eval-expression 74 --R scroll-down line to bottom eval-expression
65 -C- proportional goto-char line to middle suspend-emacs 75 -C- proportional goto-char line to middle suspend-emacs
66 76
67 To reinitialize the mouse if the terminal is reset, type ESC : RET" 77 To reinitialize the mouse if the terminal is reset, type ESC : RET"
68 (interactive "P") 78 (interactive "P")
79 (declare (special bg-mouse-x bg-mouse-y bg-cursor-window))
69 (bg-get-tty-num semicolon) 80 (bg-get-tty-num semicolon)
70 (let* 81 (let*
71 ((screen-mouse-x (min (1- (frame-width)) ;don't hit column 86! 82 ((screen-mouse-x (min (1- (frame-width)) ;don't hit column 86!
72 (/ (bg-get-tty-num semicolon) 9))) 83 (/ (bg-get-tty-num semicolon) 9)))
73 (screen-mouse-y (- (1- (frame-height)) ;assume default font size. 84 (screen-mouse-y (- (1- (frame-height)) ;assume default font size.
74 (/ (bg-get-tty-num semicolon) 16))) 85 (/ (bg-get-tty-num semicolon) 16)))
75 (bg-mouse-buttons (% (bg-get-tty-num ?c) 8)) 86 (bg-mouse-buttons (% (bg-get-tty-num ?c) 8))
76 (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y)) 87 (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y))
77 (bg-cursor-window (selected-window)) 88 (bg-cursor-window (selected-window))
78 (edges (window-edges bg-mouse-window)) 89 (edges (bg-window-edges bg-mouse-window))
79 (minibuf-p (= screen-mouse-y (1- (screen-height)))) 90 (minibuf-p (= screen-mouse-y (1- (frame-height))))
80 (in-modeline-p (and (not minibuf-p) 91 (in-modeline-p (and (not minibuf-p)
81 (= screen-mouse-y (1- (nth 3 edges))))) 92 (= screen-mouse-y (1- (nth 3 edges)))))
82 (in-scrollbar-p (and (not minibuf-p) (not in-modeline-p) 93 (in-scrollbar-p (and (not minibuf-p) (not in-modeline-p)
83 (>= screen-mouse-x (1- (nth 2 edges))))) 94 (>= screen-mouse-x (1- (nth 2 edges)))))
84 (same-window-p (eq bg-mouse-window bg-cursor-window)) 95 (same-window-p (eq bg-mouse-window bg-cursor-window))
108 ;;; Library of commands: 119 ;;; Library of commands:
109 120
110 (defun bg-set-point () 121 (defun bg-set-point ()
111 "Move point to location of BitGraph mouse." 122 "Move point to location of BitGraph mouse."
112 (interactive) 123 (interactive)
124 (declare (special bg-mouse-x bg-mouse-y))
113 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) 125 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
114 (setq this-command 'next-line) ;make subsequent line moves work 126 (setq this-command 'next-line) ;make subsequent line moves work
115 (setq temporary-goal-column bg-mouse-x)) 127 (setq temporary-goal-column bg-mouse-x))
116 128
117 (defun bg-set-mark () 129 (defun bg-set-mark ()
118 "Set mark at location of BitGraph mouse." 130 "Set mark at location of BitGraph mouse."
119 (interactive) 131 (interactive)
132 (declare (special bg-mouse-x bg-mouse-y))
120 (push-mark) 133 (push-mark)
121 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) 134 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
122 (exchange-point-and-mark)) 135 (exchange-point-and-mark))
123 136
124 (defun bg-yank () 137 (defun bg-yank ()
125 "Move point to location of BitGraph mouse and yank." 138 "Move point to location of BitGraph mouse and yank."
126 (interactive "*") 139 (interactive "*")
140 (declare (special bg-mouse-x bg-mouse-y))
127 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) 141 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
128 (setq this-command 'yank) 142 (setq this-command 'yank)
129 (yank)) 143 (yank))
130 144
131 (defun yank-pop-1 () 145 (defun yank-pop-1 ()
145 159
146 (defun bg-move-by-percentage () 160 (defun bg-move-by-percentage ()
147 "Go to location in buffer that is the same percentage of the way 161 "Go to location in buffer that is the same percentage of the way
148 through the buffer as the BitGraph mouse's X position in the window." 162 through the buffer as the BitGraph mouse's X position in the window."
149 (interactive) 163 (interactive)
164 (declare (special bg-mouse-x bg-mouse-y))
150 ;; check carefully for overflow in intermediate calculations 165 ;; check carefully for overflow in intermediate calculations
151 (goto-char 166 (goto-char
152 (cond ((zerop bg-mouse-x) 167 (cond ((zerop bg-mouse-x)
153 0) 168 0)
154 ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x)) 169 ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x))
163 (what-cursor-position)) 178 (what-cursor-position))
164 179
165 (defun bg-mouse-line-to-top () 180 (defun bg-mouse-line-to-top ()
166 "Scroll the line pointed to by the BitGraph mouse to the top of the window." 181 "Scroll the line pointed to by the BitGraph mouse to the top of the window."
167 (interactive) 182 (interactive)
183 (declare (special bg-mouse-x bg-mouse-y))
168 (scroll-up bg-mouse-y)) 184 (scroll-up bg-mouse-y))
169 185
170 (defun bg-mouse-line-to-center () 186 (defun bg-mouse-line-to-center ()
171 "Scroll the line pointed to by the BitGraph mouse to the center 187 "Scroll the line pointed to by the BitGraph mouse to the center
172 of the window." 188 of the window."
173 (interactive) 189 (interactive)
190 (declare (special bg-mouse-x bg-mouse-y))
174 (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y (- (window-height))) 2))) 191 (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y (- (window-height))) 2)))
175 192
176 (defun bg-mouse-line-to-bottom () 193 (defun bg-mouse-line-to-bottom ()
177 "Scroll the line pointed to by the mouse to the bottom of the window." 194 "Scroll the line pointed to by the mouse to the bottom of the window."
178 (interactive) 195 (interactive)
196 (declare (special bg-mouse-x bg-mouse-y))
179 (scroll-up (+ bg-mouse-y (- 2 (window-height))))) 197 (scroll-up (+ bg-mouse-y (- 2 (window-height)))))
180 198
181 (defun bg-kill-region () 199 (defun bg-kill-region ()
182 (interactive "*") 200 (interactive "*")
183 (kill-region (region-beginning) (region-end))) 201 (kill-region (region-beginning) (region-end)))
184 202
185 (defun bg-insert-moused-sexp () 203 (defun bg-insert-moused-sexp ()
186 "Insert a copy of the word (actually sexp) that the mouse is pointing at. 204 "Insert a copy of the word (actually sexp) that the mouse is pointing at.
187 Sexp is inserted into the buffer at point (where the text cursor is)." 205 Sexp is inserted into the buffer at point (where the text cursor is)."
188 (interactive) 206 (interactive)
207 (declare (special bg-mouse-x bg-mouse-y bg-cursor-window))
189 (let ((moused-text 208 (let ((moused-text
190 (save-excursion 209 (save-excursion
191 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) 210 (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
192 (if (looking-at "\\s)") 211 (if (looking-at "\\s)")
193 (forward-char 1) 212 (forward-char 1)
252 ;;; If coordinates-in-window-p were not in an X-windows-specific file 271 ;;; If coordinates-in-window-p were not in an X-windows-specific file
253 ;;; we could use that. In Emacs 19 can even use locate-window-from-coordinates 272 ;;; we could use that. In Emacs 19 can even use locate-window-from-coordinates
254 (defun bg-window-from-x-y (x y) 273 (defun bg-window-from-x-y (x y)
255 "Find window corresponding to screen coordinates. 274 "Find window corresponding to screen coordinates.
256 X and Y are 0-based character positions on the screen." 275 X and Y are 0-based character positions on the screen."
257 (let ((edges (window-edges)) 276 (let ((edges (bg-window-edges))
258 (window nil)) 277 (window nil))
259 (while (and (not (eq window (selected-window))) 278 (while (and (not (eq window (selected-window)))
260 (or (< y (nth 1 edges)) 279 (or (< y (nth 1 edges))
261 (>= y (nth 3 edges)) 280 (>= y (nth 3 edges))
262 (< x (nth 0 edges)) 281 (< x (nth 0 edges))
263 (>= x (nth 2 edges)))) 282 (>= x (nth 2 edges))))
264 (setq window (next-window window)) 283 (setq window (next-window window))
265 (setq edges (window-edges window))) 284 (setq edges (bg-window-edges window)))
266 (cond ((eq window (selected-window)) 285 (cond ((eq window (selected-window))
267 nil) ;we've looped: not found 286 nil) ;we've looped: not found
268 ((not window) 287 ((not window)
269 (selected-window)) ;just starting: current window 288 (selected-window)) ;just starting: current window
270 (t 289 (t