|
|
1.1 root 1: ;; GNU Emacs code for BBN Bitgraph mouse.
2: ;; Copyright (C) Free Software Foundation Oct 1985.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: ;;; Original version by John Robinson ([email protected], bbncca!jr), Oct 1985
23:
24: ;;; User customization option:
25:
26: (defvar bg-mouse-fast-select-window nil
27: "*Non-nil for mouse hits to select new window, then execute; else just select.")
28:
29: ;;; Defuns:
30:
31: (defun bg-mouse-report ()
32: "Read and parse BBN BitGraph mouse report, and do what it asks.
33:
34: L-- move point * |---- These apply for mouse click in a window.
35: --R set mark * | If bg-mouse-fast-select-window is nil,
36: L-R kill region | a starred command on a nonselected window
37: -C- move point and yank * | just selects that window.
38: LC- yank-pop
39: -CR or LCR undo | \"Scroll bar\" is right-hand window column.
40:
41: on modeline on \"scroll bar\" in minibuffer
42: L-- scroll-up line to top execute-extended-command
43: --R scroll-down line to bottom eval-expression
44: -C- proportional goto-char line to middle suspend-emacs
45:
46: To reenable the mouse if terminal is reset, type ESC : RET ."
47: (interactive)
48: (bg-get-tty-num ?\;)
49: (let*
50: ((x (min (1- (screen-width))
51: (/ (bg-get-tty-num ?\;) 9))) ; Don't hit column 86!
52: (y (- (1- (screen-height))
53: (/ (bg-get-tty-num ?\;) 16))) ; Assume default font size.
54: (buttons (% (bg-get-tty-num ?c) 8))
55: (window (bg-pos-to-window x y))
56: (edges (window-edges window))
57: (old-window (selected-window))
58: (in-minibuf-p (eq y (1- (screen-height))))
59: (same-window-p (and (not in-minibuf-p) (eq window old-window)))
60: (in-modeline-p (eq y (1- (nth 3 edges))))
61: (in-scrollbar-p (>= x (1- (nth 2 edges)))))
62: (setq x (- x (nth 0 edges)))
63: (setq y (- y (nth 1 edges)))
64: (cond (in-modeline-p
65: (select-window window)
66: (cond ((= buttons 4)
67: (scroll-up))
68: ((= buttons 1)
69: (scroll-down))
70: ((= buttons 2)
71: (goto-char (/ (* x
72: (- (point-max) (point-min)))
73: (1- (window-width))))
74: (beginning-of-line)
75: (what-cursor-position)))
76: (select-window old-window))
77: (in-scrollbar-p
78: (select-window window)
79: (scroll-up
80: (cond ((= buttons 4)
81: y)
82: ((= buttons 1)
83: (+ y (- 2 (window-height))))
84: ((= buttons 2)
85: (/ (+ 2 y y (- (window-height))) 2))
86: (t
87: 0)))
88: (select-window old-window))
89: (same-window-p
90: (cond ((= buttons 4)
91: (bg-move-point-to-x-y x y))
92: ((= buttons 1)
93: (push-mark)
94: (bg-move-point-to-x-y x y)
95: (exchange-point-and-mark))
96: ((= buttons 5)
97: (kill-region (mark) (point)))
98: ((= buttons 2)
99: (bg-move-point-to-x-y x y)
100: (setq this-command 'yank)
101: (yank))
102: ((= buttons 6)
103: (yank-pop 1))
104: ((or (= buttons 3) (= buttons 7))
105: (undo))
106: )
107: )
108: (in-minibuf-p
109: (cond ((= buttons 1)
110: (call-interactively 'eval-expression))
111: ((= buttons 4)
112: (call-interactively 'execute-extended-command))
113: ((= buttons 2)
114: (suspend-emacs))
115: ))
116: (t ;in another window
117: (select-window window)
118: (cond ((not bg-mouse-fast-select-window))
119: ((= buttons 4)
120: (bg-move-point-to-x-y x y))
121: ((= buttons 1)
122: (push-mark)
123: (bg-move-point-to-x-y x y)
124: (exchange-point-and-mark))
125: ((= buttons 2)
126: (bg-move-point-to-x-y x y)
127: (setq this-command 'yank)
128: (yank))
129: ))
130: )))
131:
132: (defun bg-get-tty-num (term-char)
133: "Read from terminal until TERM-CHAR is read, and return intervening number.
134: Upon non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error."
135: (let
136: ((num 0)
137: (char (- (read-char) 48)))
138: (while (and (>= char 0)
139: (<= char 9))
140: (setq num (+ (* num 10) char))
141: (setq char (- (read-char) 48)))
142: (or (eq term-char (+ char 48))
143: (progn
144: (bg-program-mouse)
145: (error "Invalid data format in mouse command")))
146: num))
147:
148: (defun bg-move-point-to-x-y (x y)
149: "Position cursor in window coordinates.
150: X and Y are 0-based character positions in the window."
151: (move-to-window-line y)
152: (move-to-column x)
153: )
154:
155: (defun bg-pos-to-window (x y)
156: "Find window corresponding to screen coordinates.
157: X and Y are 0-based character positions on the screen."
158: (let ((edges (window-edges))
159: (window nil))
160: (while (and (not (eq window (selected-window)))
161: (or (< y (nth 1 edges))
162: (>= y (nth 3 edges))
163: (< x (nth 0 edges))
164: (>= x (nth 2 edges))))
165: (setq window (next-window window))
166: (setq edges (window-edges window))
167: )
168: (or window (selected-window))
169: )
170: )
171:
172: (defun bg-program-mouse ()
173: (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c"))
174:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.