![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sup-mouse.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to sup-mouse.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 1: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2: ;; ;;
3: ;; File: sup-mouse.el ;;
4: ;; Author: Wolfgang Rupprecht ;;
5: ;; Created: Fri Nov 21 19:22:22 1986 ;;
6: ;; Contents: supdup mouse support for lisp machines ;;
7: ;; ;;
8: ;; (from code originally written by John Robinson@bbn for the bitgraph) ;;
9: ;; ;;
10: ;; $Log$ ;;
11: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12:
13: ;; GNU Emacs code for lambda/supdup mouse
14: ;; Copyright (C) Free Software Foundation 1985, 1986
15:
16: ;; This file is part of GNU Emacs.
17:
18: ;; GNU Emacs is distributed in the hope that it will be useful,
19: ;; but WITHOUT ANY WARRANTY. No author or distributor
20: ;; accepts responsibility to anyone for the consequences of using it
21: ;; or for whether it serves any particular purpose or works at all,
22: ;; unless he says so in writing. Refer to the GNU Emacs General Public
23: ;; License for full details.
24:
25: ;; Everyone is granted permission to copy, modify and redistribute
26: ;; GNU Emacs, but only under the conditions described in the
27: ;; GNU Emacs General Public License. A copy of this license is
28: ;; supposed to have been given to you along with GNU Emacs so you
29: ;; can know your rights and responsibilities. It should be in a
30: ;; file named COPYING. Among other things, the copyright notice
31: ;; and this notice must be preserved on all copies.
32:
33: ;;; User customization option:
34:
35: (defvar sup-mouse-fast-select-window nil
36: "*Non-nil for mouse hits to select new window, then execute; else just select.")
37:
38: (defconst mouse-left 0)
39: (defconst mouse-center 1)
40: (defconst mouse-right 2)
41:
42: (defconst mouse-2left 4)
43: (defconst mouse-2center 5)
44: (defconst mouse-2right 6)
45:
46: (defconst mouse-3left 8)
47: (defconst mouse-3center 9)
48: (defconst mouse-3right 10)
49:
50: ;;; Defuns:
51:
52: (defun sup-mouse-report ()
53: "This function is called directly by the mouse, it parses and
54: executes the mouse commands.
55:
56: L move point * |---- These apply for mouse click in a window.
57: 2L delete word |
58: 3L copy word | If sup-mouse-fast-select-window is nil,
59: C move point and yank * | just selects that window.
60: 2C yank pop |
61: R set mark * |
62: 2R delete region |
63: 3R copy region |
64:
65: on modeline on \"scroll bar\" in minibuffer
66: L scroll-up line to top execute-extended-command
67: C proportional goto-char line to middle mouse-help
68: R scroll-down line to bottom eval-expression"
69:
70: (interactive)
71: (let*
72: ;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
73: ((buttons (sup-get-tty-num ?\;))
74: (x (sup-get-tty-num ?\;))
75: (y (sup-get-tty-num ?c))
76: (window (sup-pos-to-window x y))
77: (edges (window-edges window))
78: (old-window (selected-window))
79: (in-minibuf-p (eq y (1- (screen-height))))
80: (same-window-p (and (not in-minibuf-p) (eq window old-window)))
81: (in-modeline-p (eq y (1- (nth 3 edges))))
82: (in-scrollbar-p (>= x (1- (nth 2 edges)))))
83: (setq x (- x (nth 0 edges)))
84: (setq y (- y (nth 1 edges)))
85:
86: ; (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
87:
88: (cond (in-modeline-p
89: (select-window window)
90: (cond ((= buttons mouse-left)
91: (scroll-up))
92: ((= buttons mouse-right)
93: (scroll-down))
94: ((= buttons mouse-center)
95: (goto-char (/ (* x
96: (- (point-max) (point-min)))
97: (1- (window-width))))
98: (beginning-of-line)
99: (what-cursor-position)))
100: (select-window old-window))
101: (in-scrollbar-p
102: (select-window window)
103: (scroll-up
104: (cond ((= buttons mouse-left)
105: y)
106: ((= buttons mouse-right)
107: (+ y (- 2 (window-height))))
108: ((= buttons mouse-center)
109: (/ (+ 2 y y (- (window-height))) 2))
110: (t
111: 0)))
112: (select-window old-window))
113: (same-window-p
114: (cond ((= buttons mouse-left)
115: (sup-move-point-to-x-y x y))
116: ((= buttons mouse-2left)
117: (sup-move-point-to-x-y x y)
118: (kill-word 1))
119: ((= buttons mouse-3left)
120: (sup-move-point-to-x-y x y)
121: (save-excursion
122: (copy-region-as-kill
123: (point) (progn (forward-word 1) (point))))
124: (setq this-command 'yank)
125: )
126: ((= buttons mouse-right)
127: (push-mark)
128: (sup-move-point-to-x-y x y)
129: (exchange-point-and-mark))
130: ((= buttons mouse-2right)
131: (push-mark)
132: (sup-move-point-to-x-y x y)
133: (kill-region (mark) (point)))
134: ((= buttons mouse-3right)
135: (push-mark)
136: (sup-move-point-to-x-y x y)
137: (copy-region-as-kill (mark) (point))
138: (setq this-command 'yank))
139: ((= buttons mouse-center)
140: (sup-move-point-to-x-y x y)
141: (setq this-command 'yank)
142: (yank))
143: ((= buttons mouse-2center)
144: (yank-pop 1))
145: )
146: )
147: (in-minibuf-p
148: (cond ((= buttons mouse-right)
149: (call-interactively 'eval-expression))
150: ((= buttons mouse-left)
151: (call-interactively 'execute-extended-command))
152: ((= buttons mouse-center)
153: (describe-function 'sup-mouse-report)); silly self help
154: ))
155: (t ;in another window
156: (select-window window)
157: (cond ((not sup-mouse-fast-select-window))
158: ((= buttons mouse-left)
159: (sup-move-point-to-x-y x y))
160: ((= buttons mouse-right)
161: (push-mark)
162: (sup-move-point-to-x-y x y)
163: (exchange-point-and-mark))
164: ((= buttons mouse-center)
165: (sup-move-point-to-x-y x y)
166: (setq this-command 'yank)
167: (yank))
168: ))
169: )))
170:
171:
172: (defun sup-get-tty-num (term-char)
173: "Read from terminal until TERM-CHAR is read, and return intervening number.
174: Upon non-numeric not matching TERM-CHAR signal an error."
175: (let
176: ((num 0)
177: (char (read-char)))
178: (while (and (>= char ?0)
179: (<= char ?9))
180: (setq num (+ (* num 10) (- char ?0)))
181: (setq char (read-char)))
182: (or (eq term-char char)
183: (error "Invalid data format in mouse command"))
184: num))
185:
186: (defun sup-move-point-to-x-y (x y)
187: "Position cursor in window coordinates.
188: X and Y are 0-based character positions in the window."
189: (move-to-window-line y)
190: (move-to-column x)
191: )
192:
193: (defun sup-pos-to-window (x y)
194: "Find window corresponding to screen coordinates.
195: X and Y are 0-based character positions on the screen."
196: (let ((edges (window-edges))
197: (window nil))
198: (while (and (not (eq window (selected-window)))
199: (or (< y (nth 1 edges))
200: (>= y (nth 3 edges))
201: (< x (nth 0 edges))
202: (>= x (nth 2 edges))))
203: (setq window (next-window window))
204: (setq edges (window-edges window))
205: )
206: (or window (selected-window))
207: )
208: )
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.